Skip to content

Commit

Permalink
Use file collating sequence for any key of alphanumeric class
Browse files Browse the repository at this point in the history
Before this change, only keys that were alphanumeric elementary items
or numeric display were supported.
  • Loading branch information
nberth committed Sep 24, 2024
1 parent e84f424 commit 56e6811
Show file tree
Hide file tree
Showing 3 changed files with 102 additions and 3 deletions.
2 changes: 2 additions & 0 deletions cobc/ChangeLog
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,8 @@
* tree.c (validate_indexed_key_field): warn about ignored collating
sequence for non-alphanumeric keys (considers only primary keys and file
collating sequence for now)
* codegen.c (output_indexed_file_key_colseq): assign collating sequence
for any key of alphanumeric class

2024-08-28 David Declerck <[email protected]>

Expand Down
6 changes: 3 additions & 3 deletions cobc/codegen.c
Original file line number Diff line number Diff line change
Expand Up @@ -9341,11 +9341,11 @@ output_indexed_file_key_colseq (const struct cb_file *f, const struct cb_alt_key
{
const cb_tree key = ak ? ak->key : f->key;
const cb_tree key_col = ak ? ak->collating_sequence_key : f->collating_sequence_key;
const int type = cb_tree_type (key, cb_code_field (key));
cb_tree col = NULL;

/* We only apply a collating sequence if the key is alphanumeric / display */
if ((type & COB_TYPE_ALNUM) || (type == COB_TYPE_NUMERIC_DISPLAY)) {
/* We only apply a collating sequence if the key is of class alphanumeric;
Warned in `validate_indexed_key_field`. */
if (CB_TREE_CLASS (key) == CB_CLASS_ALPHANUMERIC) {
col = key_col ? key_col : f->collating_sequence;
#if 0 /* TODO: this should be done for national, when available */
} else if (type & COB_TYPE_NATIONAL) {
Expand Down
97 changes: 97 additions & 0 deletions tests/testsuite.src/run_file.at
Original file line number Diff line number Diff line change
Expand Up @@ -12781,6 +12781,103 @@ AT_CHECK([diff reference_ebcdic_ascii prog8.out], [0], [], [])
AT_CLEANUP



AT_SETUP([INDEXED file with collation on group key])
AT_KEYWORDS([runfile WRITE READ EBCDIC])

AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"])

AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT MY-FILE ASSIGN TO "testfile"
ORGANIZATION IS INDEXED
ACCESS IS DYNAMIC
RECORD KEY IS MY-KEY.
DATA DIVISION.
FILE SECTION.
FD MY-FILE.
01 MY-REC.
05 MY-KEY.
10 MY-KEY-1 PIC X.
10 MY-KEY-2 PIC X.
05 MY-DATA PIC 9.
PROCEDURE DIVISION.

OPEN OUTPUT MY-FILE
MOVE "111" TO MY-REC WRITE MY-REC
MOVE "AA2" TO MY-REC WRITE MY-REC
MOVE "223" TO MY-REC WRITE MY-REC
MOVE "BB4" TO MY-REC WRITE MY-REC
MOVE "335" TO MY-REC WRITE MY-REC
MOVE "CC6" TO MY-REC WRITE MY-REC
MOVE "447" TO MY-REC WRITE MY-REC
MOVE "DD8" TO MY-REC WRITE MY-REC
CLOSE MY-FILE

OPEN INPUT MY-FILE
MOVE LOW-VALUES TO MY-KEY
START MY-FILE KEY >= MY-KEY
INVALID KEY
DISPLAY "INVALID KEY"
NOT INVALID KEY
PERFORM UNTIL EXIT
READ MY-FILE NEXT
AT END
EXIT PERFORM
NOT AT END
DISPLAY MY-REC
END-READ
END-PERFORM
END-START.
CLOSE MY-FILE

STOP RUN.
])

AT_DATA([expout],
[ASCII:
111
223
335
447
AA2
BB4
CC6
DD8
EBCDIC:
AA2
BB4
CC6
DD8
111
223
335
447
])

# Note: ignore any unfinished warning as the test is about the runtime behavior:
AT_CHECK([$COMPILE -Wno-unfinished -fdefault-file-colseq=ASCII prog.cob -o ascii], [0])
AT_CHECK([$COMPILE -Wno-unfinished -fdefault-file-colseq=EBCDIC prog.cob -o ebcdic], [0])

# This is, so far, only supported by the BDB backend
AT_CHECK([test "$COB_HAS_ISAM" = "db"], [0], [], [],
# Previous test "failed" --> other ISAM, skip the test
[AT_CHECK([true])],

# Previous test "passed" --> using BDB, perform the actual test
[AT_CHECK([
echo "ASCII:" && $COBCRUN_DIRECT ./ascii && \
echo "EBCDIC:" && $COBCRUN_DIRECT ./ebcdic
], [0], [expout]) # <- compare stdout with exiting `expout`
])

AT_CLEANUP


AT_SETUP([INDEXED file numeric keys ordering])
AT_KEYWORDS([runfile])

Expand Down

0 comments on commit 56e6811

Please sign in to comment.