Warn when a collating sequence is ignored for keys of indexed files

Author: nberth

cobc/ChangeLog

@@ -1,4 +1,10 @@
 
+2024-09-12  Nicolas Berthier <[email protected]>
+
+	* 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)
+
 2024-08-28  David Declerck <[email protected]>
 
 	* tree.c (char_to_precedence_idx, get_char_type_description, valid_char_order):

cobc/tree.c

@@ -4712,7 +4712,7 @@ validate_indexed_key_field (struct cb_file *f, struct cb_field *records,
 	int			cb;
 	char			pic[32];
 	struct cb_key_component	*key_component;
-	struct cb_field		*composite_key;
+	struct cb_field		*composite_key = NULL;
 
 	/* get reference (and check if it exists) */
 	key_ref = cb_ref (key);
@@ -4781,6 +4781,22 @@ validate_indexed_key_field (struct cb_file *f, struct cb_field *records,
 			}
 		}
 	}
+
+	/* check collating sequence is not ignored */
+	if (composite_key != NULL /* split keys are considered alphanums */
+	 && CB_TREE_CLASS (k) != CB_CLASS_ALPHANUMERIC) {
+		cb_tree colseq = (cbak == NULL)
+			? f->collating_sequence_key
+			: cbak->collating_sequence_key;
+		if (colseq == NULL) {
+			colseq = f->collating_sequence;
+		}
+		if (colseq != NULL) {
+			cb_warning_x (COBC_WARN_FILLER, CB_TREE(colseq),
+				      _("COLLATING SEQUENCE is ignored for non-alphanumeric"
+					" key '%s'"), k->name);
+		}
+	}
 }
 
 void

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"])
@@ -12691,7 +12691,9 @@ AT_DATA([prog1.cob], [
          ==FILE-COLSEQ== BY ==COLLATING SEQUENCE IS ASCII==
          ==KEY-COLSEQ== BY ====.
 ])
-AT_CHECK([$COMPILE -Wno-unfinished prog1.cob], [0], [], [])
+AT_CHECK([$COMPILE -Wno-unfinished prog1.cob], [0], [],
+[prog.cpy:18: warning: COLLATING SEQUENCE is ignored for non-alphanumeric key 'MY-AKEY2'
+])
 AT_CHECK([$COBCRUN_DIRECT ./prog1 1>prog1.out], [0], [], [])
 AT_CHECK([diff reference_ascii prog1.out], [0], [], [])
 
@@ -12712,7 +12714,9 @@ 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 prog3.cob], [0], [],
+[prog.cpy:18: warning: COLLATING SEQUENCE is ignored for non-alphanumeric key 'MY-AKEY2'
+])
 AT_CHECK([$COBCRUN_DIRECT ./prog3 1>prog3.out], [0], [], [])
 AT_CHECK([diff reference_ascii_ebcdic prog3.out], [0], [], [])
 
@@ -12732,7 +12736,9 @@ 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 prog5.cob], [0], [],
+[prog.cpy:18: warning: COLLATING SEQUENCE is ignored for non-alphanumeric key 'MY-AKEY2'
+])
 AT_CHECK([$COBCRUN_DIRECT ./prog5 1>prog5.out], [0], [], [])
 AT_CHECK([diff reference_ebcdic prog5.out], [0], [], [])
 
@@ -12742,7 +12748,9 @@ 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 -fdefault-file-colseq=EBCDIC prog6.cob], [0], [],
+[prog.cpy:15: warning: COLLATING SEQUENCE is ignored for non-alphanumeric key 'MY-AKEY2'
+])
 AT_CHECK([$COBCRUN_DIRECT ./prog6 1>prog6.out], [0], [], [])
 AT_CHECK([diff reference_ebcdic prog6.out], [0], [], [])
 
@@ -12752,7 +12760,9 @@ 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 prog7.cob], [0], [],
+[prog.cpy:18: warning: COLLATING SEQUENCE is ignored for non-alphanumeric key 'MY-AKEY2'
+])
 AT_CHECK([$COBCRUN_DIRECT ./prog7 1>prog7.out], [0], [], [])
 AT_CHECK([diff reference_ebcdic_ascii prog7.out], [0], [], [])
 
@@ -12762,7 +12772,9 @@ 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 -fdefault-file-colseq=EBCDIC prog8.cob], [0], [],
+[prog.cpy:15: warning: COLLATING SEQUENCE is ignored for non-alphanumeric key 'MY-AKEY2'
+])
 AT_CHECK([$COBCRUN_DIRECT ./prog8 1>prog8.out], [0], [], [])
 AT_CHECK([diff reference_ebcdic_ascii prog8.out], [0], [], [])
 

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,27 @@ 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
        DATA             DIVISION.
        FILE             SECTION.
        FD TEST-SOME.
@@ -670,6 +691,20 @@ 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).
        WORKING-STORAGE  SECTION.
        77  TEST-P2   PIC S9(4) COMP.
        77  TEST-P3   PIC S9(5) COMP-3.
@@ -681,13 +716,22 @@ 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:33: 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:39: 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:46: 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: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:32: warning: COLLATING SEQUENCE is ignored for non-alphanumeric key 'TEST-P5'
+prog.cob:32: warning: COLLATING SEQUENCE is ignored for non-alphanumeric key 'TEST-P6'
+prog.cob:39: warning: COLLATING SEQUENCE is ignored for non-alphanumeric key 'TEST-P8'
 prog.cob:25: error: 'NOT-IN-FILE2' is not defined
 ])