Skip to content

Bugfix about WHEN condition of SEARCH #551

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
Nov 14, 2024
Merged

Bugfix about WHEN condition of SEARCH #551

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
185f83b
Add allow-key-in-rhs.conf
tsh-hashimoto Nov 13, 2024
626c222
Update conf.at
tsh-hashimoto Nov 13, 2024
84d2852
move allow-key-in-rhs: config/ -> tests/command-line-option.src
tsh-hashimoto Nov 14, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
153 changes: 153 additions & 0 deletions tests/command-line-options.src/allow-key-in-rhs.conf
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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
166 changes: 166 additions & 0 deletions tests/command-line-options.src/conf.at
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Loading