Skip to content

Commit 4436faa

Browse files
tsh-hashimototsh-hashimoto
authored
Bugfix about WHEN condition of SEARCH (#551)
* Add allow-key-in-rhs.conf * Update conf.at * move allow-key-in-rhs: config/ -> tests/command-line-option.src
1 parent 46ef3dc commit 4436faa

File tree

2 files changed

+319
-0
lines changed

2 files changed

+319
-0
lines changed

‎tests/command-line-options.src/allow-key-in-rhs.conf‎

Lines changed: 153 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,153 @@
1+
# COBOL compiler configuration -*- sh -*-
2+
3+
# Value: any string
4+
name: "OpenCOBOL"
5+
6+
# Value: int
7+
tab-width: 8
8+
text-column: 72
9+
10+
# Value: 'record-sequential', 'line-sequential'
11+
# This sets the default organization for sequential files,
12+
# where the organization is not explicitly defined.
13+
default-organization: record-sequential
14+
15+
# Value: 'cobol2002', 'mf', 'ibm', 'jph1'
16+
assign-clause: mf
17+
18+
# If yes, file names are resolved at run time using environment variables.
19+
# For example, given ASSIGN TO "DATAFILE", the actual file name will be
20+
# 1. the value of environment variable 'DD_DATAFILE' or
21+
# 2. the value of environment variable 'dd_DATAFILE' or
22+
# 3. the value of environment variable 'DATAFILE' or
23+
# 4. the literal "DATAFILE"
24+
# If no, the value of the assign clause is the file name.
25+
#
26+
# Value: 'yes', 'no'
27+
filename-mapping: yes
28+
29+
# Value: 'yes', 'no'
30+
pretty-display: yes
31+
32+
# Value: 'yes', 'no'
33+
auto-initialize: yes
34+
35+
# Value: 'yes', 'no'
36+
complex-odo: no
37+
38+
# Value: 'yes', 'no'
39+
indirect-redefines: no
40+
41+
# Binary byte size - defines the allocated bytes according to PIC
42+
# Value: signed unsigned bytes
43+
# ------ -------- -----
44+
# '2-4-8' 1 - 4 2
45+
# 5 - 9 4
46+
# 10 - 18 8
47+
#
48+
# '1-2-4-8' 1 - 2 1
49+
# 3 - 4 2
50+
# 5 - 9 4
51+
# 10 - 18 8
52+
#
53+
# '1--8' 1 - 2 1 - 2 1
54+
# 3 - 4 3 - 4 2
55+
# 5 - 6 5 - 7 3
56+
# 7 - 9 8 - 9 4
57+
# 10 - 11 10 - 12 5
58+
# 12 - 14 13 - 14 6
59+
# 15 - 16 15 - 16 7
60+
# 17 - 18 17 - 18 8
61+
binary-size: 1-2-4-8
62+
63+
# Value: 'yes', 'no'
64+
binary-truncate: yes
65+
66+
# Value: 'native', 'big-endian'
67+
binary-byteorder: big-endian
68+
69+
# Value: 'any', 'fatal', 'never'
70+
abort-on-io-exception: any
71+
72+
# Value: 'yes', 'no'
73+
larger-redefines-ok: no
74+
75+
# Value: 'yes', 'no'
76+
relaxed-syntax-check: no
77+
78+
# Perform type OSVS - If yes, the exit point of any currently executing perform
79+
# is recognized if reached.
80+
# Value: 'yes', 'no'
81+
perform-osvs: no
82+
83+
# If yes, linkage-section items remain allocated
84+
# between invocations.
85+
# Value: 'yes', 'no'
86+
sticky-linkage: no
87+
88+
# If yes, set the file assign to the external file
89+
# Value: 'yes', 'no'
90+
assign_external: no
91+
92+
# If yes, allow non-matching level numbers
93+
# Value: 'yes', 'no'
94+
relax-level-hierarchy: no
95+
96+
# not-reserved:
97+
# Value: Word to be taken out of the reserved words list
98+
# (case independent)
99+
100+
# Dialect features
101+
# Value: 'ok', 'archaic', 'obsolete', 'skip', 'ignore', 'unconformable'
102+
author-paragraph: obsolete
103+
memory-size-clause: obsolete
104+
multiple-file-tape-clause: obsolete
105+
label-records-clause: obsolete
106+
value-of-clause: obsolete
107+
data-records-clause: obsolete
108+
top-level-occurs-clause: skip
109+
synchronized-clause: ok
110+
goto-statement-without-name: obsolete
111+
stop-literal-statement: obsolete
112+
debugging-line: obsolete
113+
padding-character-clause: obsolete
114+
next-sentence-phrase: archaic
115+
eject-statement: skip
116+
entry-statement: obsolete
117+
move-noninteger-to-alphanumeric: error
118+
odo-without-to: ok
119+
120+
# Value: any single character
121+
default-currency-symbol: $
122+
123+
# Value: int
124+
max-alpha-character-data-size: 2147483647
125+
max-sjis-character-data-size: 1073741823
126+
max-utf8-character-data-size: 715827882
127+
128+
# If yes, length of PROGRAM-ID of after translation is bigger than
129+
# 31 characters, give warning.
130+
c89-identifier-length-check: no
131+
132+
# jp compatible
133+
# Value: 'yes', 'no'
134+
allow-end-program-with-wrong-name: no
135+
allow-missing-also-clause-in-evaluate: no
136+
allow-empty-imperative-statement: no
137+
enable-program-status-register: no
138+
enable-sort-status-register: no
139+
enable-special-names-argument-clause: no
140+
enable-special-names-environment-clause: no
141+
enable-leng-intrinsic-function: no
142+
enable-length-an-intrinsic-function: no
143+
enable-national-intrinsic-function: no
144+
use-invalidkey-handler-on-status34: no
145+
cobol68-copy-in-data-description: no
146+
switch-no-mnemonic: no
147+
allow-is-in-sort-key-spec: no
148+
allow-search-key-in-rhs: yes
149+
ignore-invalid-record-contains: no
150+
enable-zero-division-error: no
151+
enable-check-subscript-out-of-bounds: no
152+
enable-expect-numeric-error: no
153+
enable-expect-compute-string-error: no

‎tests/command-line-options.src/conf.at‎

Lines changed: 166 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,3 +17,169 @@ AT_CHECK([${COBJ} -conf=hello.conf prog.cbl], [1], [],
1717
])
1818

1919
AT_CLEANUP
20+
21+
22+
AT_SETUP([allow search key in rhs])
23+
24+
# without SEARCH ALL
25+
AT_DATA([prog.cbl], [
26+
IDENTIFICATION DIVISION.
27+
PROGRAM-ID. prog.
28+
DATA DIVISION.
29+
WORKING-STORAGE SECTION.
30+
PROCEDURE DIVISION.
31+
MAIN-RTN.
32+
DISPLAY "HELLO, WORLD!!".
33+
STOP RUN.
34+
])
35+
AT_CHECK([${COBJ} prog.cbl], [0])
36+
AT_CHECK([${COBJ} -conf=../../command-line-options.src/allow-key-in-rhs.conf prog.cbl], [0])
37+
38+
39+
# key item of OCCURS is LEFT hand side on WHEN condition
40+
AT_DATA([prog.cbl], [
41+
IDENTIFICATION DIVISION.
42+
PROGRAM-ID. prog.
43+
DATA DIVISION.
44+
WORKING-STORAGE SECTION.
45+
01 ELEMENT_COUNT PIC 9(03) VALUE 3.
46+
01 RECORD_ARRAY.
47+
02 FILLER OCCURS 3.
48+
03 METRIC_COUNT PIC 9(03).
49+
01 RECORD_ID PIC X(02).
50+
01 RECORD_KEY.
51+
02 RECORD_STRUCT.
52+
03 RECORD_CODE PIC X(04).
53+
03 RECORD_TYPE PIC X(02).
54+
02 SERIAL_NO PIC 9(02).
55+
01 DATA_TABLE.
56+
02 ELEMENT OCCURS 1 TO 150
57+
DEPENDING ON ELEMENT_COUNT
58+
ASCENDING KEY TABLE_KEY INDEXED BY INDEX_K.
59+
03 TABLE_KEY.
60+
04 KEY_CODE.
61+
05 RECORD_CODE_KEY PIC X(04).
62+
05 RECORD_TYPE_KEY PIC X(02).
63+
04 SERIAL_NO_KEY PIC 9(02).
64+
03 FILLER PIC X(02).
65+
03 METRIC_DATA.
66+
04 METRIC_ELEMENT OCCURS 10 INDEXED BY INDEX_J.
67+
05 METER_NO PIC X(08).
68+
05 ADDITION_FLAG PIC X(01).
69+
03 FILLER PIC X(02).
70+
*
71+
PROCEDURE DIVISION.
72+
MAIN_ROUTINE.
73+
SEARCH ALL ELEMENT
74+
AT END
75+
MOVE ZERO TO METRIC_COUNT(1)
76+
GO TO EXIT_ROUTINE
77+
WHEN TABLE_KEY(INDEX_K) = RECORD_KEY
78+
MOVE KEY_CODE(INDEX_K) TO RECORD_ID
79+
SET METRIC_COUNT(1) TO INDEX_K.
80+
EXIT_ROUTINE.
81+
MAIN_EXIT.
82+
STOP RUN.
83+
])
84+
AT_CHECK([${COBJ} prog.cbl], [0])
85+
AT_CHECK([${COBJ} -conf=../../command-line-options.src/allow-key-in-rhs.conf prog.cbl], [0])
86+
87+
88+
# key item of OCCURS is RIGHT hand side on WHEN condition
89+
AT_DATA([prog.cbl], [
90+
IDENTIFICATION DIVISION.
91+
PROGRAM-ID. prog.
92+
DATA DIVISION.
93+
WORKING-STORAGE SECTION.
94+
01 ELEMENT_COUNT PIC 9(03) VALUE 3.
95+
01 RECORD_ARRAY.
96+
02 FILLER OCCURS 3.
97+
03 METRIC_COUNT PIC 9(03).
98+
01 RECORD_ID PIC X(02).
99+
01 RECORD_KEY.
100+
02 RECORD_STRUCT.
101+
03 RECORD_CODE PIC X(04).
102+
03 RECORD_TYPE PIC X(02).
103+
02 SERIAL_NO PIC 9(02).
104+
01 DATA_TABLE.
105+
02 ELEMENT OCCURS 1 TO 150
106+
DEPENDING ON ELEMENT_COUNT
107+
ASCENDING KEY TABLE_KEY INDEXED BY INDEX_K.
108+
03 TABLE_KEY.
109+
04 KEY_CODE.
110+
05 RECORD_CODE_KEY PIC X(04).
111+
05 RECORD_TYPE_KEY PIC X(02).
112+
04 SERIAL_NO_KEY PIC 9(02).
113+
03 FILLER PIC X(02).
114+
03 METRIC_DATA.
115+
04 METRIC_ELEMENT OCCURS 10 INDEXED BY INDEX_J.
116+
05 METER_NO PIC X(08).
117+
05 ADDITION_FLAG PIC X(01).
118+
03 FILLER PIC X(02).
119+
*
120+
PROCEDURE DIVISION.
121+
MAIN_ROUTINE.
122+
SEARCH ALL ELEMENT
123+
AT END
124+
MOVE ZERO TO METRIC_COUNT(1)
125+
GO TO EXIT_ROUTINE
126+
WHEN RECORD_KEY = TABLE_KEY(INDEX_K)
127+
MOVE KEY_CODE(INDEX_K) TO RECORD_ID
128+
SET METRIC_COUNT(1) TO INDEX_K.
129+
EXIT_ROUTINE.
130+
MAIN_EXIT.
131+
STOP RUN.
132+
])
133+
AT_CHECK([(${COBJ} prog.cbl | grep "Undeclared key") > a.txt 2>&1], [1])
134+
AT_CHECK([${COBJ} -conf=../../command-line-options.src/allow-key-in-rhs.conf prog.cbl], [0])
135+
136+
137+
# only key item on WHEN condition
138+
AT_DATA([prog.cbl], [
139+
IDENTIFICATION DIVISION.
140+
PROGRAM-ID. prog.
141+
DATA DIVISION.
142+
WORKING-STORAGE SECTION.
143+
01 ELEMENT_COUNT PIC 9(03) VALUE 3.
144+
01 RECORD_ARRAY.
145+
02 FILLER OCCURS 3.
146+
03 METRIC_COUNT PIC 9(03).
147+
01 RECORD_ID PIC X(02).
148+
01 RECORD_KEY.
149+
02 RECORD_STRUCT.
150+
03 RECORD_CODE PIC X(04).
151+
03 RECORD_TYPE PIC X(02).
152+
02 SERIAL_NO PIC 9(02).
153+
01 DATA_TABLE.
154+
02 ELEMENT OCCURS 1 TO 150
155+
DEPENDING ON ELEMENT_COUNT
156+
ASCENDING KEY TABLE_KEY INDEXED BY INDEX_K.
157+
03 TABLE_KEY.
158+
04 KEY_CODE.
159+
05 RECORD_CODE_KEY PIC X(04).
160+
05 RECORD_TYPE_KEY PIC X(02).
161+
04 SERIAL_NO_KEY PIC 9(02).
162+
03 FILLER PIC X(02).
163+
03 METRIC_DATA.
164+
04 METRIC_ELEMENT OCCURS 10 INDEXED BY INDEX_J.
165+
05 METER_NO PIC X(08).
166+
05 ADDITION_FLAG PIC X(01).
167+
03 FILLER PIC X(02).
168+
*
169+
PROCEDURE DIVISION.
170+
MAIN_ROUTINE.
171+
SEARCH ALL ELEMENT
172+
AT END
173+
MOVE ZERO TO METRIC_COUNT(1)
174+
GO TO EXIT_ROUTINE
175+
WHEN TABLE_KEY(INDEX_K)
176+
MOVE KEY_CODE(INDEX_K) TO RECORD_ID
177+
SET METRIC_COUNT(1) TO INDEX_K.
178+
EXIT_ROUTINE.
179+
MAIN_EXIT.
180+
STOP RUN.
181+
])
182+
AT_CHECK([(${COBJ} prog.cbl | grep "Invalid type cast") > a.txt 2>&1], [1])
183+
AT_CHECK([(${COBJ} -conf=../../command-line-options.src/allow-key-in-rhs.conf prog.cbl | grep "Invalid type cast") > a.txt 2>&1], [1])
184+
185+
AT_CLEANUP

0 commit comments

Comments
 (0)