From 9b0259d78f87e479887f617206a002636c8e57cb Mon Sep 17 00:00:00 2001 From: nberth Date: Tue, 1 Oct 2024 09:00:58 +0000 Subject: [PATCH] Support collating sequence for indexed file keys of alphanumeric class cobc: * 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, and preliminary handing of NATIONAL collations * parser.y: adjust position of messages about unfinished KEY or FILE COLLATING SEQUENCE --- cobc/ChangeLog | 13 ++- cobc/codegen.c | 12 +-- cobc/parser.y | 4 +- cobc/tree.c | 21 +++++ tests/testsuite.src/run_file.at | 159 ++++++++++++++++++++++++++++++-- tests/testsuite.src/syn_file.at | 57 +++++++++++- 6 files changed, 247 insertions(+), 19 deletions(-) diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 05399a1d6..3d38e0246 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,4 +1,15 @@ +2024-10-01 Nicolas Berthier + + * 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, and preliminary handing of NATIONAL + collations + * parser.y: adjust position of messages about unfinished KEY or FILE + COLLATING SEQUENCE + 2024-09-29 Simon Sobisch * cobc.c (cobc_print_info): drop COB_LI_IS_LL @@ -6,7 +17,7 @@ 2024-09-27 Simon Sobisch - * plex.l, scanner.l: use noyywrap option instead of manually + * plex.l, scanner.l: use noyywrap option instead of manually defining related code parts * typeck.c (cb_tree_list_has_numeric_ref_or_field): cleanup diff --git a/cobc/codegen.c b/cobc/codegen.c index 298917312..d3bcc2fc7 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -9341,16 +9341,14 @@ 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) { - col = key_col_n ? key_col_n : f->collating_sequence_n; -#endif + } else if (CB_TREE_CLASS (key) == CB_CLASS_NATIONAL) { + col = f->collating_sequence_n; } output_prefix (); diff --git a/cobc/parser.y b/cobc/parser.y index 5f4eebe45..6293848c0 100644 --- a/cobc/parser.y +++ b/cobc/parser.y @@ -5784,7 +5784,7 @@ collating_sequence_clause: check_repeated ("COLLATING", SYN_CLAUSE_3, &check_duplicate); current_file->collating_sequence = alphanumeric_collation; current_file->collating_sequence_n = national_collation; - CB_UNFINISHED ("FILE COLLATING SEQUENCE"); /* only implemented for BDB */ + CB_UNFINISHED_X (alphanumeric_collation, "FILE COLLATING SEQUENCE"); /* only implemented for BDB */ } ; @@ -5836,7 +5836,7 @@ collating_sequence_clause_key: and also attached to the correct key later, so just store in a list here: */ current_file->collating_sequence_keys = cb_list_add(current_file->collating_sequence_keys, CB_BUILD_PAIR ($6, $4)); - CB_UNFINISHED ("KEY COLLATING SEQUENCE"); /* only implemented for BDB */ + CB_UNFINISHED_X ($6, "KEY COLLATING SEQUENCE"); /* only implemented for BDB */ } ; diff --git a/cobc/tree.c b/cobc/tree.c index cb49c88c8..0e2f9bb18 100644 --- a/cobc/tree.c +++ b/cobc/tree.c @@ -4781,6 +4781,27 @@ validate_indexed_key_field (struct cb_file *f, struct cb_field *records, } } } + + /* check collating sequence is not ignored */ + if (get_warn_opt_value (cb_warn_filler) != COBC_WARN_DISABLED + && CB_TREE_CLASS (k) != CB_CLASS_ALPHANUMERIC) { + const char *source = "KEY"; + cb_tree colseq = (cbak == NULL) + ? f->collating_sequence_key + : cbak->collating_sequence_key; + cb_tree pos = colseq; + if (colseq == NULL) { + source = "FILE"; + colseq = f->collating_sequence; + pos = key_ref; + } + if (colseq != NULL) { + cb_warning_x (COBC_WARN_FILLER, CB_TREE (pos), + _("%s COLLATING SEQUENCE '%s' is ignored " + "for non-alphanumeric key '%s'"), + source, CB_NAME (colseq), k->name); + } + } } void diff --git a/tests/testsuite.src/run_file.at b/tests/testsuite.src/run_file.at index 11a491571..2aed60f08 100644 --- a/tests/testsuite.src/run_file.at +++ b/tests/testsuite.src/run_file.at @@ -12444,7 +12444,7 @@ AT_CLEANUP # This is, so far, only supported by the BDB backend -AT_SETUP([INDEXED files under ASCII/EBCDIC collation]) +AT_SETUP([INDEXED file under ASCII/EBCDIC collation]) AT_KEYWORDS([runfile WRITE DELETE READ EBCDIC]) AT_SKIP_IF([test "$COB_HAS_ISAM" != "db"]) @@ -12685,13 +12685,15 @@ CCC 888 +0000000043 1 DONE ]) +# Note: `-Wno-others` is for ignored COLLATIONS for non-alphanumeric keys + # Testing ASCII file collating sequence using clause AT_DATA([prog1.cob], [ COPY "prog.cpy" REPLACING ==FILE-COLSEQ== BY ==COLLATING SEQUENCE IS ASCII== ==KEY-COLSEQ== BY ====. ]) -AT_CHECK([$COMPILE -Wno-unfinished prog1.cob], [0], [], []) +AT_CHECK([$COMPILE -Wno-unfinished -Wno-others prog1.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog1 1>prog1.out], [0], [], []) AT_CHECK([diff reference_ascii prog1.out], [0], [], []) @@ -12712,7 +12714,7 @@ AT_DATA([prog3.cob], [ ==FILE-COLSEQ== BY ==COLLATING SEQUENCE IS ASCII== ==KEY-COLSEQ== BY ==COLLATING SEQUENCE OF MY-AKEY1 IS EBCDIC==. ]) -AT_CHECK([$COMPILE -Wno-unfinished prog3.cob], [0], [], []) +AT_CHECK([$COMPILE -Wno-unfinished -Wno-others prog3.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog3 1>prog3.out], [0], [], []) AT_CHECK([diff reference_ascii_ebcdic prog3.out], [0], [], []) @@ -12732,7 +12734,7 @@ AT_DATA([prog5.cob], [ ==FILE-COLSEQ== BY ==COLLATING SEQUENCE IS EBCDIC== ==KEY-COLSEQ== BY ==COLLATING SEQUENCE OF MY-AKEY1 IS EBCDIC==. ]) -AT_CHECK([$COMPILE -Wno-unfinished prog5.cob], [0], [], []) +AT_CHECK([$COMPILE -Wno-unfinished -Wno-others prog5.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog5 1>prog5.out], [0], [], []) AT_CHECK([diff reference_ebcdic prog5.out], [0], [], []) @@ -12742,7 +12744,7 @@ AT_DATA([prog6.cob], [ ==FILE-COLSEQ== BY ==== ==KEY-COLSEQ== BY ====. ]) -AT_CHECK([$COMPILE -Wno-unfinished -fdefault-file-colseq=EBCDIC prog6.cob], [0], [], []) +AT_CHECK([$COMPILE -Wno-unfinished -Wno-others -fdefault-file-colseq=EBCDIC prog6.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog6 1>prog6.out], [0], [], []) AT_CHECK([diff reference_ebcdic prog6.out], [0], [], []) @@ -12752,7 +12754,7 @@ AT_DATA([prog7.cob], [ ==FILE-COLSEQ== BY ==COLLATING SEQUENCE IS EBCDIC== ==KEY-COLSEQ== BY ==COLLATING SEQUENCE OF MY-AKEY1 IS ASCII==. ]) -AT_CHECK([$COMPILE -Wno-unfinished prog7.cob], [0], [], []) +AT_CHECK([$COMPILE -Wno-unfinished -Wno-others prog7.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog7 1>prog7.out], [0], [], []) AT_CHECK([diff reference_ebcdic_ascii prog7.out], [0], [], []) @@ -12762,13 +12764,156 @@ AT_DATA([prog8.cob], [ ==FILE-COLSEQ== BY ==== ==KEY-COLSEQ== BY ==COLLATING SEQUENCE OF MY-AKEY1 IS ASCII==. ]) -AT_CHECK([$COMPILE -Wno-unfinished -fdefault-file-colseq=EBCDIC prog8.cob], [0], [], []) +AT_CHECK([$COMPILE -Wno-unfinished -Wno-others -fdefault-file-colseq=EBCDIC prog8.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog8 1>prog8.out], [0], [], []) 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"]) + +# This is, so far, only supported by the BDB backend +AT_XFAIL_IF([test "$COB_HAS_ISAM" != "db"]) + +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]) + +AT_CHECK([ + echo "ASCII:" && $COBCRUN_DIRECT ./ascii && \ + echo "EBCDIC:" && $COBCRUN_DIRECT ./ebcdic +], [0], [expout]) # <- compare stdout with existing `expout` + +AT_CLEANUP + + +# Note: codegen only for now +AT_SETUP([INDEXED file with NATIONAL collation]) +AT_KEYWORDS([runfile]) + +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 + COLLATING SEQUENCE FOR NATIONAL IS ASCII. + DATA DIVISION. + FILE SECTION. + FD MY-FILE. + 01 MY-REC. + 05 MY-KEY PIC N. + 05 MY-DATA PIC 9. + PROCEDURE DIVISION. + + OPEN OUTPUT MY-FILE + MOVE "11" TO MY-REC WRITE MY-REC + MOVE "A2" TO MY-REC WRITE MY-REC + MOVE "23" TO MY-REC WRITE MY-REC + MOVE "B4" TO MY-REC WRITE MY-REC + MOVE "35" TO MY-REC WRITE MY-REC + MOVE "C6" TO MY-REC WRITE MY-REC + MOVE "47" TO MY-REC WRITE MY-REC + MOVE "D8" TO MY-REC WRITE MY-REC + CLOSE MY-FILE + + STOP RUN. +]) + +AT_DATA([expout], []) + +# Note: ignore any unfinished warning as the test is about the runtime behavior: +AT_CHECK([$COMPILE -Wno-unfinished prog.cob], [0], [], +[prog.cob:11: warning: NATIONAL COLLATING SEQUENCE is not implemented +]) + +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [expout]) + +AT_CLEANUP + + AT_SETUP([INDEXED file numeric keys ordering]) AT_KEYWORDS([runfile]) diff --git a/tests/testsuite.src/syn_file.at b/tests/testsuite.src/syn_file.at index 24c1f835f..1f43f9025 100644 --- a/tests/testsuite.src/syn_file.at +++ b/tests/testsuite.src/syn_file.at @@ -631,7 +631,7 @@ AT_CLEANUP AT_SETUP([INDEXED file invalid key items]) -AT_KEYWORDS([record ALTERNATE split]) +AT_KEYWORDS([record ALTERNATE split collation]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -658,6 +658,32 @@ AT_DATA([prog.cob], [ RECORD KEY IS NOT-HERE-KEY SOURCE IS NOT-IN-FILE1 NOT-IN-FILE2. + SELECT TEST-CSQ1 ASSIGN TO 'FILE-TEST-COSQ1' + ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC + RECORD KEY IS TEST-P5 + ALTERNATE KEY IS TEST-P6 + ALTERNATE KEY IS TEST-P7 + COLLATING SEQUENCE IS EBCDIC + COLLATING SEQUENCE OF TEST-P7 IS EBCDIC. + SELECT TEST-CSQ2 ASSIGN TO 'FILE-TEST-COSQ2' + ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC + RECORD KEY IS TEST-P8 + COLLATING SEQUENCE IS EBCDIC *> unused + COLLATING SEQUENCE OF TEST-P8 IS EBCDIC. + SELECT TEST-CSQ3 ASSIGN TO 'FILE-TEST-COSQ3' + ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC + RECORD KEY IS SPLIT-KEY1 = TEST-P9 TEST-P10 + ALTERNATE KEY IS SPLIT-KEY2 = TEST-P9 TEST-P11 + COLLATING SEQUENCE IS EBCDIC *> should not warn + COLLATING SEQUENCE OF SPLIT-KEY2 IS EBCDIC.*> should not warn + SELECT TEST-CSQ4 ASSIGN TO 'FILE-TEST-COSQ4' + ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC + RECORD KEY IS SPLIT-KEY3 = TEST-P12 + COLLATING SEQUENCE OF SPLIT-KEY1 IS EBCDIC. DATA DIVISION. FILE SECTION. FD TEST-SOME. @@ -670,6 +696,23 @@ AT_DATA([prog.cob], [ FD TEST-MORE. 01 MORE-REC. 05 MORE-DATA PIC X(4). + FD TEST-CSQ1. + 01 CSQ1-REC. + 05 TEST-P5 PIC 9(2) BINARY. + 05 TEST-P6 PIC 9(2) BINARY. + 05 TEST-P7 PIC X(2). + FD TEST-CSQ2. + 01 CSQ2-REC. + 05 TEST-P8 PIC 9(2) BINARY. + 05 TEST-P8X PIC X(2). + FD TEST-CSQ3. + 01 CSQ3-REC. + 05 TEST-P9 PIC 9(2) BINARY. + 05 TEST-P10 PIC 9(2) BINARY. + 05 TEST-P11 PIC X(2). + FD TEST-CSQ4. + 01 CSQ4-REC. + 05 TEST-P12 PIC 9(2) BINARY. WORKING-STORAGE SECTION. 77 TEST-P2 PIC S9(4) COMP. 77 TEST-P3 PIC S9(5) COMP-3. @@ -681,13 +724,23 @@ AT_DATA([prog.cob], [ # FIXME: "is not defined" should be changed in "is not defined in file ..." AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:10: error: 'TEST-P2' is not defined +[prog.cob:32: warning: handling of FILE COLLATING SEQUENCE is unfinished; implementation is likely to be changed +prog.cob:33: warning: handling of KEY COLLATING SEQUENCE is unfinished; implementation is likely to be changed +prog.cob:38: warning: handling of FILE COLLATING SEQUENCE is unfinished; implementation is likely to be changed +prog.cob:39: warning: handling of KEY COLLATING SEQUENCE is unfinished; implementation is likely to be changed +prog.cob:45: warning: handling of FILE COLLATING SEQUENCE is unfinished; implementation is likely to be changed +prog.cob:46: warning: handling of KEY COLLATING SEQUENCE is unfinished; implementation is likely to be changed +prog.cob:51: warning: handling of KEY COLLATING SEQUENCE is unfinished; implementation is likely to be changed +prog.cob:10: error: 'TEST-P2' is not defined prog.cob:11: error: 'TEST-P1' is not defined prog.cob:12: error: 'TEST-P3' is not defined prog.cob:18: error: 'NOT-THERE' is not defined prog.cob:13: error: invalid KEY item 'SOME-REC', not in file 'TEST-FILE' prog.cob:24: error: 'NOT-IN-FILE1' is not defined prog.cob:20: error: invalid KEY item 'NOT-HERE-KEY', not in file 'TEST-MORE' +prog.cob:66: warning: FILE COLLATING SEQUENCE 'EBCDIC' is ignored for non-alphanumeric key 'TEST-P5' +prog.cob:67: warning: FILE COLLATING SEQUENCE 'EBCDIC' is ignored for non-alphanumeric key 'TEST-P6' +prog.cob:39: warning: KEY COLLATING SEQUENCE 'EBCDIC' is ignored for non-alphanumeric key 'TEST-P8' prog.cob:25: error: 'NOT-IN-FILE2' is not defined ])