diff --git a/tests/command-line-options.src/allow-key-in-rhs.conf b/tests/command-line-options.src/allow-key-in-rhs.conf new file mode 100644 index 00000000..daa28900 --- /dev/null +++ b/tests/command-line-options.src/allow-key-in-rhs.conf @@ -0,0 +1,153 @@ +# COBOL compiler configuration -*- sh -*- + +# Value: any string +name: "OpenCOBOL" + +# Value: int +tab-width: 8 +text-column: 72 + +# Value: 'record-sequential', 'line-sequential' +# This sets the default organization for sequential files, +# where the organization is not explicitly defined. +default-organization: record-sequential + +# Value: 'cobol2002', 'mf', 'ibm', 'jph1' +assign-clause: mf + +# If yes, file names are resolved at run time using environment variables. +# For example, given ASSIGN TO "DATAFILE", the actual file name will be +# 1. the value of environment variable 'DD_DATAFILE' or +# 2. the value of environment variable 'dd_DATAFILE' or +# 3. the value of environment variable 'DATAFILE' or +# 4. the literal "DATAFILE" +# If no, the value of the assign clause is the file name. +# +# Value: 'yes', 'no' +filename-mapping: yes + +# Value: 'yes', 'no' +pretty-display: yes + +# Value: 'yes', 'no' +auto-initialize: yes + +# Value: 'yes', 'no' +complex-odo: no + +# Value: 'yes', 'no' +indirect-redefines: no + +# Binary byte size - defines the allocated bytes according to PIC +# Value: signed unsigned bytes +# ------ -------- ----- +# '2-4-8' 1 - 4 2 +# 5 - 9 4 +# 10 - 18 8 +# +# '1-2-4-8' 1 - 2 1 +# 3 - 4 2 +# 5 - 9 4 +# 10 - 18 8 +# +# '1--8' 1 - 2 1 - 2 1 +# 3 - 4 3 - 4 2 +# 5 - 6 5 - 7 3 +# 7 - 9 8 - 9 4 +# 10 - 11 10 - 12 5 +# 12 - 14 13 - 14 6 +# 15 - 16 15 - 16 7 +# 17 - 18 17 - 18 8 +binary-size: 1-2-4-8 + +# Value: 'yes', 'no' +binary-truncate: yes + +# Value: 'native', 'big-endian' +binary-byteorder: big-endian + +# Value: 'any', 'fatal', 'never' +abort-on-io-exception: any + +# Value: 'yes', 'no' +larger-redefines-ok: no + +# Value: 'yes', 'no' +relaxed-syntax-check: no + +# Perform type OSVS - If yes, the exit point of any currently executing perform +# is recognized if reached. +# Value: 'yes', 'no' +perform-osvs: no + +# If yes, linkage-section items remain allocated +# between invocations. +# Value: 'yes', 'no' +sticky-linkage: no + +# If yes, set the file assign to the external file +# Value: 'yes', 'no' +assign_external: no + +# If yes, allow non-matching level numbers +# Value: 'yes', 'no' +relax-level-hierarchy: no + +# not-reserved: +# Value: Word to be taken out of the reserved words list +# (case independent) + +# Dialect features +# Value: 'ok', 'archaic', 'obsolete', 'skip', 'ignore', 'unconformable' +author-paragraph: obsolete +memory-size-clause: obsolete +multiple-file-tape-clause: obsolete +label-records-clause: obsolete +value-of-clause: obsolete +data-records-clause: obsolete +top-level-occurs-clause: skip +synchronized-clause: ok +goto-statement-without-name: obsolete +stop-literal-statement: obsolete +debugging-line: obsolete +padding-character-clause: obsolete +next-sentence-phrase: archaic +eject-statement: skip +entry-statement: obsolete +move-noninteger-to-alphanumeric: error +odo-without-to: ok + +# Value: any single character +default-currency-symbol: $ + +# Value: int +max-alpha-character-data-size: 2147483647 +max-sjis-character-data-size: 1073741823 +max-utf8-character-data-size: 715827882 + +# If yes, length of PROGRAM-ID of after translation is bigger than +# 31 characters, give warning. +c89-identifier-length-check: no + +# jp compatible +# Value: 'yes', 'no' +allow-end-program-with-wrong-name: no +allow-missing-also-clause-in-evaluate: no +allow-empty-imperative-statement: no +enable-program-status-register: no +enable-sort-status-register: no +enable-special-names-argument-clause: no +enable-special-names-environment-clause: no +enable-leng-intrinsic-function: no +enable-length-an-intrinsic-function: no +enable-national-intrinsic-function: no +use-invalidkey-handler-on-status34: no +cobol68-copy-in-data-description: no +switch-no-mnemonic: no +allow-is-in-sort-key-spec: no +allow-search-key-in-rhs: yes +ignore-invalid-record-contains: no +enable-zero-division-error: no +enable-check-subscript-out-of-bounds: no +enable-expect-numeric-error: no +enable-expect-compute-string-error: no diff --git a/tests/command-line-options.src/conf.at b/tests/command-line-options.src/conf.at index 0f1b6a41..ee3f161e 100644 --- a/tests/command-line-options.src/conf.at +++ b/tests/command-line-options.src/conf.at @@ -17,3 +17,169 @@ AT_CHECK([${COBJ} -conf=hello.conf prog.cbl], [1], [], ]) AT_CLEANUP + + +AT_SETUP([allow search key in rhs]) + +# without SEARCH ALL +AT_DATA([prog.cbl], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + MAIN-RTN. + DISPLAY "HELLO, WORLD!!". + STOP RUN. +]) +AT_CHECK([${COBJ} prog.cbl], [0]) +AT_CHECK([${COBJ} -conf=../../command-line-options.src/allow-key-in-rhs.conf prog.cbl], [0]) + + +# key item of OCCURS is LEFT hand side on WHEN condition +AT_DATA([prog.cbl], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 ELEMENT_COUNT PIC 9(03) VALUE 3. + 01 RECORD_ARRAY. + 02 FILLER OCCURS 3. + 03 METRIC_COUNT PIC 9(03). + 01 RECORD_ID PIC X(02). + 01 RECORD_KEY. + 02 RECORD_STRUCT. + 03 RECORD_CODE PIC X(04). + 03 RECORD_TYPE PIC X(02). + 02 SERIAL_NO PIC 9(02). + 01 DATA_TABLE. + 02 ELEMENT OCCURS 1 TO 150 + DEPENDING ON ELEMENT_COUNT + ASCENDING KEY TABLE_KEY INDEXED BY INDEX_K. + 03 TABLE_KEY. + 04 KEY_CODE. + 05 RECORD_CODE_KEY PIC X(04). + 05 RECORD_TYPE_KEY PIC X(02). + 04 SERIAL_NO_KEY PIC 9(02). + 03 FILLER PIC X(02). + 03 METRIC_DATA. + 04 METRIC_ELEMENT OCCURS 10 INDEXED BY INDEX_J. + 05 METER_NO PIC X(08). + 05 ADDITION_FLAG PIC X(01). + 03 FILLER PIC X(02). + * + PROCEDURE DIVISION. + MAIN_ROUTINE. + SEARCH ALL ELEMENT + AT END + MOVE ZERO TO METRIC_COUNT(1) + GO TO EXIT_ROUTINE + WHEN TABLE_KEY(INDEX_K) = RECORD_KEY + MOVE KEY_CODE(INDEX_K) TO RECORD_ID + SET METRIC_COUNT(1) TO INDEX_K. + EXIT_ROUTINE. + MAIN_EXIT. + STOP RUN. +]) +AT_CHECK([${COBJ} prog.cbl], [0]) +AT_CHECK([${COBJ} -conf=../../command-line-options.src/allow-key-in-rhs.conf prog.cbl], [0]) + + +# key item of OCCURS is RIGHT hand side on WHEN condition +AT_DATA([prog.cbl], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 ELEMENT_COUNT PIC 9(03) VALUE 3. + 01 RECORD_ARRAY. + 02 FILLER OCCURS 3. + 03 METRIC_COUNT PIC 9(03). + 01 RECORD_ID PIC X(02). + 01 RECORD_KEY. + 02 RECORD_STRUCT. + 03 RECORD_CODE PIC X(04). + 03 RECORD_TYPE PIC X(02). + 02 SERIAL_NO PIC 9(02). + 01 DATA_TABLE. + 02 ELEMENT OCCURS 1 TO 150 + DEPENDING ON ELEMENT_COUNT + ASCENDING KEY TABLE_KEY INDEXED BY INDEX_K. + 03 TABLE_KEY. + 04 KEY_CODE. + 05 RECORD_CODE_KEY PIC X(04). + 05 RECORD_TYPE_KEY PIC X(02). + 04 SERIAL_NO_KEY PIC 9(02). + 03 FILLER PIC X(02). + 03 METRIC_DATA. + 04 METRIC_ELEMENT OCCURS 10 INDEXED BY INDEX_J. + 05 METER_NO PIC X(08). + 05 ADDITION_FLAG PIC X(01). + 03 FILLER PIC X(02). + * + PROCEDURE DIVISION. + MAIN_ROUTINE. + SEARCH ALL ELEMENT + AT END + MOVE ZERO TO METRIC_COUNT(1) + GO TO EXIT_ROUTINE + WHEN RECORD_KEY = TABLE_KEY(INDEX_K) + MOVE KEY_CODE(INDEX_K) TO RECORD_ID + SET METRIC_COUNT(1) TO INDEX_K. + EXIT_ROUTINE. + MAIN_EXIT. + STOP RUN. +]) +AT_CHECK([(${COBJ} prog.cbl | grep "Undeclared key") > a.txt 2>&1], [1]) +AT_CHECK([${COBJ} -conf=../../command-line-options.src/allow-key-in-rhs.conf prog.cbl], [0]) + + +# only key item on WHEN condition +AT_DATA([prog.cbl], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 ELEMENT_COUNT PIC 9(03) VALUE 3. + 01 RECORD_ARRAY. + 02 FILLER OCCURS 3. + 03 METRIC_COUNT PIC 9(03). + 01 RECORD_ID PIC X(02). + 01 RECORD_KEY. + 02 RECORD_STRUCT. + 03 RECORD_CODE PIC X(04). + 03 RECORD_TYPE PIC X(02). + 02 SERIAL_NO PIC 9(02). + 01 DATA_TABLE. + 02 ELEMENT OCCURS 1 TO 150 + DEPENDING ON ELEMENT_COUNT + ASCENDING KEY TABLE_KEY INDEXED BY INDEX_K. + 03 TABLE_KEY. + 04 KEY_CODE. + 05 RECORD_CODE_KEY PIC X(04). + 05 RECORD_TYPE_KEY PIC X(02). + 04 SERIAL_NO_KEY PIC 9(02). + 03 FILLER PIC X(02). + 03 METRIC_DATA. + 04 METRIC_ELEMENT OCCURS 10 INDEXED BY INDEX_J. + 05 METER_NO PIC X(08). + 05 ADDITION_FLAG PIC X(01). + 03 FILLER PIC X(02). + * + PROCEDURE DIVISION. + MAIN_ROUTINE. + SEARCH ALL ELEMENT + AT END + MOVE ZERO TO METRIC_COUNT(1) + GO TO EXIT_ROUTINE + WHEN TABLE_KEY(INDEX_K) + MOVE KEY_CODE(INDEX_K) TO RECORD_ID + SET METRIC_COUNT(1) TO INDEX_K. + EXIT_ROUTINE. + MAIN_EXIT. + STOP RUN. +]) +AT_CHECK([(${COBJ} prog.cbl | grep "Invalid type cast") > a.txt 2>&1], [1]) +AT_CHECK([(${COBJ} -conf=../../command-line-options.src/allow-key-in-rhs.conf prog.cbl | grep "Invalid type cast") > a.txt 2>&1], [1]) + +AT_CLEANUP