From 6939a314a3786fcf492c21b83084fedc16deefc6 Mon Sep 17 00:00:00 2001 From: David Declerck Date: Thu, 25 Jan 2024 15:44:56 +0100 Subject: [PATCH] Add support for collating sequences on indexed files --- NEWS | 6 + cobc/ChangeLog | 13 + cobc/cobc.c | 50 ++-- cobc/codegen.c | 40 +++ cobc/flag.def | 4 + cobc/parser.y | 45 ++-- cobc/tree.c | 53 +++- cobc/tree.h | 13 + libcob/ChangeLog | 8 + libcob/coblocal.h | 3 + libcob/common.c | 12 +- libcob/common.h | 4 +- libcob/fileio.c | 54 +++- tests/testsuite.src/run_file.at | 419 ++++++++++++++++++++++++++++++++ 14 files changed, 662 insertions(+), 62 deletions(-) diff --git a/NEWS b/NEWS index 55977763f..1d116c6f6 100644 --- a/NEWS +++ b/NEWS @@ -10,6 +10,9 @@ NEWS - user visible changes -*- outline -*- the error output for format errors (for example invalid indicator column) is now limitted to 5 per source file +** support the COLLATING SEQUENCE clause on indexed files + (currently only with the BDB backend) + more work in progress * Important Bugfixes @@ -41,6 +44,9 @@ NEWS - user visible changes -*- outline -*- build system do not correctly work together to locate files from diagnostic output +** New option -fdefault-file-colseq to specify the default + file collating sequence + * More notable changes ** execution times were significantly reduced for the following: diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 4beeb50c3..6df472887 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,4 +1,17 @@ +2024-01-25 David Declerck + + FR #459: support COLLATING SEQUENCE clause on SELECT / INDEXED files + * codegen.c (output_file_initialization): output the indexed + file/keys collating sequence (were already present in the AST) + * tree.c (validate_indexed_key_field): process postponed + key collating sequences + * parser.y (collating_sequence_clause, collating_sequence_clause_key): + replace CB_PENDING by CB_UNFINISHED on file and key collating sequence + * flag.def, tree.c, tree.h, cobc.c, parser.y: add and handle a new + -fdefault-file-colseq flag to specify the default collating + sequence to use for files without a collating sequence clause + 2023-10-12 Fabrice Le Fessant * cobc.c, codegen.c: new option --include FILE, to #include diff --git a/cobc/cobc.c b/cobc/cobc.c index 5285e3b7f..d89878c7d 100644 --- a/cobc/cobc.c +++ b/cobc/cobc.c @@ -90,24 +90,25 @@ enum compile_level { CB_LEVEL_EXECUTABLE = 7 }; -#define CB_FLAG_GETOPT_STACK_SIZE 1 -#define CB_FLAG_GETOPT_IF_CUTOFF 2 -#define CB_FLAG_GETOPT_SIGN 3 -#define CB_FLAG_GETOPT_FOLD_COPY 4 -#define CB_FLAG_GETOPT_FOLD_CALL 5 -#define CB_FLAG_GETOPT_TTITLE 6 -#define CB_FLAG_GETOPT_MAX_ERRORS 7 -#define CB_FLAG_GETOPT_DUMP 8 -#define CB_FLAG_GETOPT_CALLFH 9 -#define CB_FLAG_GETOPT_INTRINSICS 10 -#define CB_FLAG_GETOPT_EC 11 -#define CB_FLAG_GETOPT_NO_EC 12 -#define CB_FLAG_GETOPT_NO_DUMP 13 -#define CB_FLAG_GETOPT_EBCDIC_TABLE 14 -#define CB_FLAG_GETOPT_DEFAULT_COLSEQ 15 -#define CB_FLAG_GETOPT_MEMORY_CHECK 16 -#define CB_FLAG_GETOPT_COPY_FILE 17 -#define CB_FLAG_GETOPT_INCLUDE_FILE 18 +#define CB_FLAG_GETOPT_STACK_SIZE 1 +#define CB_FLAG_GETOPT_IF_CUTOFF 2 +#define CB_FLAG_GETOPT_SIGN 3 +#define CB_FLAG_GETOPT_FOLD_COPY 4 +#define CB_FLAG_GETOPT_FOLD_CALL 5 +#define CB_FLAG_GETOPT_TTITLE 6 +#define CB_FLAG_GETOPT_MAX_ERRORS 7 +#define CB_FLAG_GETOPT_DUMP 8 +#define CB_FLAG_GETOPT_CALLFH 9 +#define CB_FLAG_GETOPT_INTRINSICS 10 +#define CB_FLAG_GETOPT_EC 11 +#define CB_FLAG_GETOPT_NO_EC 12 +#define CB_FLAG_GETOPT_NO_DUMP 13 +#define CB_FLAG_GETOPT_EBCDIC_TABLE 14 +#define CB_FLAG_GETOPT_DEFAULT_COLSEQ 15 +#define CB_FLAG_GETOPT_DEFAULT_FILE_COLSEQ 16 +#define CB_FLAG_GETOPT_MEMORY_CHECK 17 +#define CB_FLAG_GETOPT_COPY_FILE 18 +#define CB_FLAG_GETOPT_INCLUDE_FILE 19 /* Info display limits */ @@ -3819,6 +3820,13 @@ process_command_line (const int argc, char **argv) } break; + case CB_FLAG_GETOPT_DEFAULT_FILE_COLSEQ: /* 16 */ + /* -fdefault-file-colseq= */ + if (cb_deciph_default_file_colseq_name (cob_optarg)) { + cobc_err_exit (COBC_INV_PAR, "-fdefault-file-colseq"); + } + break; + case CB_FLAG_GETOPT_FOLD_COPY: /* 4 */ /* -ffold-copy= : COPY fold case */ if (!cb_strcasecmp (cob_optarg, "UPPER")) { @@ -3898,7 +3906,7 @@ process_command_line (const int argc, char **argv) } break; - case CB_FLAG_GETOPT_MEMORY_CHECK: /* 16 */ + case CB_FLAG_GETOPT_MEMORY_CHECK: /* 17 */ /* -fmemory-check= : */ if (!cob_optarg) { cb_flag_memory_check = CB_MEMCHK_ALL; @@ -3907,7 +3915,7 @@ process_command_line (const int argc, char **argv) } break; - case CB_FLAG_GETOPT_COPY_FILE: /* 17 */ + case CB_FLAG_GETOPT_COPY_FILE: /* 18 */ /* --copy= : COPY file at beginning */ if (strlen (cob_optarg) > (COB_MINI_MAX)) { cobc_err_exit (COBC_INV_PAR, "--copy"); @@ -3916,7 +3924,7 @@ process_command_line (const int argc, char **argv) cobc_strdup (cob_optarg)); break; - case CB_FLAG_GETOPT_INCLUDE_FILE: /* 18 */ + case CB_FLAG_GETOPT_INCLUDE_FILE: /* 19 */ /* -include= : add #include "file.h" to generated C file */ if (strlen (cob_optarg) > (COB_MINI_MAX)) { diff --git a/cobc/codegen.c b/cobc/codegen.c index ab323a4f9..f65c91ed6 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -9271,6 +9271,40 @@ output_key_components (struct cb_file* f, struct cb_key_component* key_component } } + +static void +output_indexed_file_key_colseq (const struct cb_file *f, const struct cb_alt_key *ak, int idx) +{ + cb_tree key = ak ? ak->key : f->key; + cb_tree key_col = ak ? ak->collating_sequence_key : f->collating_sequence_key; + 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)) { + 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 + } + + output_prefix (); + if (idx == 0) { + output ("%s%s->collating_sequence = ", CB_PREFIX_KEYS, f->cname); + } else { + output ("(%s%s + %d)->collating_sequence = ", CB_PREFIX_KEYS, f->cname, idx); + } + if ((col != NULL) && CB_REFERENCE_P (col)) { + output_param (cb_ref(col), -1); + output (";"); + } else { + output ("NULL;"); + } + output_newline (); +} + static void output_file_initialization (struct cb_file *f) { @@ -9331,6 +9365,9 @@ output_file_initialization (struct cb_file *f) } else { output_line ("%s%s->offset = 0;", CB_PREFIX_KEYS, f->cname); } + if (f->organization == COB_ORG_INDEXED) { + output_indexed_file_key_colseq (f, NULL, 0); + } nkeys = 1; for (l = f->alt_key_list; l; l = l->next) { output_prefix (); @@ -9353,6 +9390,9 @@ output_file_initialization (struct cb_file *f) f->cname, nkeys); output_key_components (f, l->component_list, nkeys); } + if (f->organization == COB_ORG_INDEXED) { + output_indexed_file_key_colseq (f, l, nkeys); + } nkeys++; } #if 0 /* now done in cob_file_malloc / cob_file_external_addr */ diff --git a/cobc/flag.def b/cobc/flag.def index ff16d6f3d..ea7f0c98a 100644 --- a/cobc/flag.def +++ b/cobc/flag.def @@ -103,6 +103,10 @@ CB_FLAG_NQ (1, "default-colseq", CB_FLAG_GETOPT_DEFAULT_COLSEQ, _(" -fdefault-colseq=[ASCII|EBCDIC|NATIVE]\tdefine default collating sequence\n" " * default: NATIVE")) +CB_FLAG_NQ (1, "default-file-colseq", CB_FLAG_GETOPT_DEFAULT_FILE_COLSEQ, + _(" -fdefault-file-colseq=[ASCII|EBCDIC|NATIVE]\tdefine default file collating sequence\n" + " * default: NATIVE")) + /* Binary flags */ /* Flags with suppressed help */ diff --git a/cobc/parser.y b/cobc/parser.y index 3b463150b..38abd6663 100644 --- a/cobc/parser.y +++ b/cobc/parser.y @@ -336,29 +336,6 @@ check_non_area_a (cb_tree stmt) { /* Collating sequences */ -/* Known collating sequences/alphabets */ -enum cb_colseq { - CB_COLSEQ_NATIVE, - CB_COLSEQ_ASCII, - CB_COLSEQ_EBCDIC, -}; -enum cb_colseq cb_default_colseq = CB_COLSEQ_NATIVE; - -/* Decipher character conversion table names */ -int cb_deciph_default_colseq_name (const char * const name) -{ - if (!cb_strcasecmp (name, "ASCII")) { - cb_default_colseq = CB_COLSEQ_ASCII; - } else if (!cb_strcasecmp (name, "EBCDIC")) { - cb_default_colseq = CB_COLSEQ_EBCDIC; - } else if (!cb_strcasecmp (name, "NATIVE")) { - cb_default_colseq = CB_COLSEQ_NATIVE; - } else { - return 1; - } - return 0; -} - static cb_tree build_colseq_tree (const char *alphabet_name, int alphabet_type, @@ -901,23 +878,34 @@ check_relaxed_syntax (const cob_flags_t lev) } static void -setup_default_collation (struct cb_program *program) { - switch (cb_default_colseq) { +prepare_default_collation (enum cb_colseq colseq) { + switch (colseq) { #ifdef COB_EBCDIC_MACHINE case CB_COLSEQ_ASCII: #else case CB_COLSEQ_EBCDIC: #endif - alphanumeric_collation = build_colseq (cb_default_colseq); + alphanumeric_collation = build_colseq (colseq); break; default: alphanumeric_collation = NULL; } national_collation = NULL; /* TODO: default national collation */ +} + +static void +setup_default_collation (struct cb_program *program) { + prepare_default_collation (cb_default_colseq); program->collating_sequence = alphanumeric_collation; program->collating_sequence_n = national_collation; } +static void +setup_default_file_collation (struct cb_file *file) { + prepare_default_collation (cb_default_file_colseq); + file->collating_sequence = alphanumeric_collation; +} + static void program_init_without_program_id (void) { @@ -5365,6 +5353,7 @@ file_control_entry: } key_type = NO_KEY; + setup_default_file_collation (current_file); } _select_clauses_or_error { @@ -5752,7 +5741,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_PENDING ("FILE COLLATING SEQUENCE"); + CB_UNFINISHED ("FILE COLLATING SEQUENCE"); } ; @@ -5804,7 +5793,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_PENDING ("KEY COLLATING SEQUENCE"); + CB_UNFINISHED ("KEY COLLATING SEQUENCE"); } ; diff --git a/cobc/tree.c b/cobc/tree.c index 0e945aeaf..2502e3a8f 100644 --- a/cobc/tree.c +++ b/cobc/tree.c @@ -4661,9 +4661,12 @@ validate_file (struct cb_file *f, cb_tree name) static void validate_indexed_key_field (struct cb_file *f, struct cb_field *records, - cb_tree key, struct cb_key_component *component_list) + cb_tree key, struct cb_key_component *component_list, + struct cb_alt_key *cbak) { cb_tree key_ref; + cb_tree l; + struct cb_field *k; struct cb_field *p; struct cb_field *v; @@ -4730,6 +4733,18 @@ validate_indexed_key_field (struct cb_file *f, struct cb_field *records, " needs to be at least %d"), f->record_min, k->name, field_end); } } + + /* get key collating sequence, if any */ + for (l = f->collating_sequence_keys; l; l = CB_CHAIN (l)) { + cb_tree alpha_key = CB_VALUE (l); + if (key_ref == cb_ref (CB_PAIR_Y (alpha_key))) { + if (cbak == NULL) { + f->collating_sequence_key = CB_PAIR_X (alpha_key); + } else { + cbak->collating_sequence_key = CB_PAIR_X (alpha_key); + } + } + } } void @@ -4771,7 +4786,7 @@ finalize_file (struct cb_file *f, struct cb_field *records) struct cb_alt_key *cbak; if (f->key) { validate_indexed_key_field (f, records, - f->key, f->component_list); + f->key, f->component_list, NULL); } for (cbak = f->alt_key_list; cbak; cbak = cbak->next) { if (f->flag_global) { @@ -4781,7 +4796,7 @@ finalize_file (struct cb_file *f, struct cb_field *records) } } validate_indexed_key_field (f, records, - cbak->key, cbak->component_list); + cbak->key, cbak->component_list, cbak); } } @@ -7414,6 +7429,38 @@ cb_build_ml_suppress_checks (struct cb_ml_generate_tree *tree) } +enum cb_colseq cb_default_colseq = CB_COLSEQ_NATIVE; +enum cb_colseq cb_default_file_colseq = CB_COLSEQ_NATIVE; + +/* Decipher character conversion table names */ +static int +cb_deciph_colseq_name (const char * const name, enum cb_colseq *colseq) +{ + if (!cb_strcasecmp (name, "ASCII")) { + *colseq = CB_COLSEQ_ASCII; + } else if (!cb_strcasecmp (name, "EBCDIC")) { + *colseq = CB_COLSEQ_EBCDIC; + } else if (!cb_strcasecmp (name, "NATIVE")) { + *colseq = CB_COLSEQ_NATIVE; + } else { + return 1; + } + return 0; +} + +int +cb_deciph_default_colseq_name (const char * const name) +{ + return cb_deciph_colseq_name (name, &cb_default_colseq); +} + +int +cb_deciph_default_file_colseq_name (const char * const name) +{ + return cb_deciph_colseq_name (name, &cb_default_file_colseq); +} + + #ifndef HAVE_DESIGNATED_INITS void cobc_init_tree (void) diff --git a/cobc/tree.h b/cobc/tree.h index a9d668772..f9302a2ec 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -2343,6 +2343,7 @@ extern cb_tree cb_debug_sub_3; extern cb_tree cb_debug_contents; extern int cb_deciph_default_colseq_name (const char *const); +extern int cb_deciph_default_file_colseq_name (const char *const); extern struct cb_program *cb_build_program (struct cb_program *, const int); @@ -2740,5 +2741,17 @@ extern int cobc_has_areacheck_directive (const char *directive); #define CB_CHAIN_PAIR(x,y,z) x = cb_pair_add (x, y, z) #define CB_FIELD_ADD(x,y) x = cb_field_add (x, y) +enum cb_colseq { + CB_COLSEQ_NATIVE, + CB_COLSEQ_ASCII, + CB_COLSEQ_EBCDIC, +}; + +extern enum cb_colseq cb_default_colseq; +extern enum cb_colseq cb_default_file_colseq; + +extern int cb_deciph_default_colseq_name (const char * const name); +extern int cb_deciph_default_file_colseq_name (const char * const name); + #endif /* CB_TREE_H */ diff --git a/libcob/ChangeLog b/libcob/ChangeLog index fe972dd3b..c3ca493a7 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -1,4 +1,12 @@ +2024-01-25 David Declerck + + FR #459: support COLLATING SEQUENCE clause on SELECT / INDEXED files + * fileio.c (bdb_setkeycol, bdb_bt_compare, indexed_open, ...): + take the file collating sequence into account when comparing keys + * common.c, coblocal.h: rename common_cmps to cob_cmps + and make it available locally + 2023-12-14 David Declerck * common.c (cob_terminate_routines, cob_call_with_exception_check): diff --git a/libcob/coblocal.h b/libcob/coblocal.h index 27f8de170..23bd23227 100644 --- a/libcob/coblocal.h +++ b/libcob/coblocal.h @@ -570,6 +570,9 @@ cob_max_int (const int x, const int y) return y; } +COB_HIDDEN int cob_cmps (const unsigned char *, const unsigned char *, + const size_t, const unsigned char *); + #undef COB_HIDDEN #endif /* COB_LOCAL_H */ diff --git a/libcob/common.c b/libcob/common.c index 9dacd1d94..bdf4e9c13 100644 --- a/libcob/common.c +++ b/libcob/common.c @@ -1822,8 +1822,8 @@ common_cmpc (const unsigned char *p, const unsigned int c, /* compare up to 'size' characters in 's1' to 's2' using collation 'col' */ -static int -common_cmps (const unsigned char *s1, const unsigned char *s2, +int +cob_cmps (const unsigned char *s1, const unsigned char *s2, const size_t size, const unsigned char *col) { register const unsigned char *end = s1 + size; @@ -1943,7 +1943,7 @@ cob_cmp_all (cob_field *f1, cob_field *f2) const size_t chunk_size = size2; size_t size_loop = size1; while (size_loop >= chunk_size) { - if ((ret = common_cmps (data1, data2, chunk_size, col)) != 0) { + if ((ret = cob_cmps (data1, data2, chunk_size, col)) != 0) { break; } size_loop -= chunk_size; @@ -1951,7 +1951,7 @@ cob_cmp_all (cob_field *f1, cob_field *f2) } if (!ret && size1 > 0) { - ret = common_cmps (data1, data2, size_loop, col); + ret = cob_cmps (data1, data2, size_loop, col); } } @@ -1991,7 +1991,7 @@ cob_cmp_alnum (cob_field *f1, cob_field *f2) } else { /* check with collation */ /* Compare common substring */ - if ((ret = common_cmps (data1, data2, min, col)) != 0) { + if ((ret = cob_cmps (data1, data2, min, col)) != 0) { return ret; } @@ -2052,7 +2052,7 @@ sort_compare_collate (const void *data1, const void *data2) if (COB_FIELD_IS_NUMERIC (&f1)) { res = cob_numeric_cmp (&f1, &f2); } else { - res = common_cmps (f1.data, f2.data, f1.size, sort_collate); + res = cob_cmps (f1.data, f2.data, f1.size, sort_collate); } if (res != 0) { return (sort_keys[i].flag == COB_ASCENDING) ? res : -res; diff --git a/libcob/common.h b/libcob/common.h index e81d175ba..0bda18a5f 100644 --- a/libcob/common.h +++ b/libcob/common.h @@ -1370,9 +1370,7 @@ typedef struct __cob_file_key { unsigned int offset; /* Offset of field */ int count_components; /* 0..1::simple-key 2..n::split-key */ cob_field *component[COB_MAX_KEYCOMP]; /* key-components iff split-key */ -#if 0 /* TODO (for file keys, not for SORT/MERGE) */ - const unsigned char *collating_sequence; /* COLLATING */ -#endif + const unsigned char *collating_sequence; /* COLLATING (for file keys, not for SORT/MERGE) */ } cob_file_key; diff --git a/libcob/fileio.c b/libcob/fileio.c index 4a644e1fe..a7b0bca45 100644 --- a/libcob/fileio.c +++ b/libcob/fileio.c @@ -691,6 +691,16 @@ static unsigned int bdb_lock_id = 0; key.data = fld->data; \ key.size = (cob_dbtsize_t) fld->size +#if (DB_VERSION_MAJOR > 4) || ((DB_VERSION_MAJOR == 4) && (DB_VERSION_MINOR > 0)) +#define DBT_SET_APP_DATA(key,data) ((key)->app_data = (data)) +#define DBT_GET_APP_DATA(key) ((key)->app_data) +#else +/* Workaround for older BDB versions that do not have app_data in DBT */ +static void *bdb_app_data = NULL; +#define DBT_SET_APP_DATA(key,data) ((void)(key), bdb_app_data = (data)) +#define DBT_GET_APP_DATA(key) ((void)(key), bdb_app_data) +#endif + struct indexed_file { DB **db; /* Database handlers */ DBC **cursor; @@ -757,6 +767,13 @@ bdb_savekey (cob_file *f, unsigned char *keyarea, unsigned char *record, int idx return (int)f->keys[idx].field->size; } +static void +bdb_setkeycol (cob_file *f, int idx) +{ + struct indexed_file *p = f->file; + DBT_SET_APP_DATA(&p->key, (void *)f->keys[idx].collating_sequence); +} + static void bdb_setkey (cob_file *f, int idx) { @@ -767,6 +784,7 @@ bdb_setkey (cob_file *f, int idx) len = bdb_savekey (f, p->savekey, f->record->data, idx); p->key.data = p->savekey; p->key.size = (cob_dbtsize_t) len; + bdb_setkeycol (f, idx); } /* Compare key for given index 'keyarea' to 'record'. @@ -3909,6 +3927,7 @@ indexed_start_internal (cob_file *f, const int cond, cob_field *key, } p->key.data = p->data.data; p->key.size = p->primekeylen; + bdb_setkeycol (f, 0); ret = DB_GET (p->db[0], &p->key, &p->data, 0); } @@ -4011,6 +4030,7 @@ indexed_delete_internal (cob_file *f, const int rewrite) len = bdb_savekey(f, p->savekey, p->saverec, i); p->key.data = p->savekey; p->key.size = (cob_dbtsize_t) len; + bdb_setkeycol (f, i); /* rewrite: no delete if secondary key is unchanged */ if (rewrite) { bdb_savekey (f, p->suppkey, p->saverec, i); @@ -4150,6 +4170,30 @@ indexed_file_delete (cob_file *f, const char *filename) #endif } +static int +indexed_key_compare (const unsigned char *k1, const unsigned char *k2, + size_t sz, const unsigned char *col) +{ + if (col == NULL) { + return memcmp (k1, k2, sz); + } else { + return cob_cmps (k1, k2, sz, col); + } +} + +static int +bdb_bt_compare(DB *db, const DBT *k1, const DBT *k2) +{ + const unsigned char *col = (unsigned char *)DBT_GET_APP_DATA(k1); + if (unlikely (col == NULL)) { + cob_runtime_error ("bdb_bt_compare was set but no collating sequence was stored in DBT"); + } + if (unlikely (k1->size != k2->size)) { + cob_runtime_error ("bdb_bt_compare was given keys of different length"); + } + return indexed_key_compare(k1->data, k2->data, k2->size, col); +} + /* OPEN INDEXED file */ static int @@ -4617,6 +4661,9 @@ indexed_open (cob_file *f, char *filename, if (f->keys[i].tf_duplicates) { p->db[i]->set_flags (p->db[i], DB_DUP); } + if (f->keys[i].collating_sequence) { + p->db[i]->set_bt_compare(p->db[i], bdb_bt_compare); + } } } else { handle_created = 0; @@ -5379,6 +5426,7 @@ indexed_read_next (cob_file *f, const int read_opts) /* Check if previously read data still exists */ p->key.size = (cob_dbtsize_t) bdb_keylen(f,p->key_index); p->key.data = p->last_readkey[p->key_index]; + bdb_setkeycol (f, p->key_index); ret = DB_SEQ (p->cursor[p->key_index], &p->key, &p->data, DB_SET); if (!ret && p->key_index > 0) { if (f->keys[p->key_index].tf_duplicates) { @@ -5404,6 +5452,7 @@ indexed_read_next (cob_file *f, const int read_opts) if (!ret) { p->key.size = (cob_dbtsize_t) p->primekeylen; p->key.data = p->last_readkey[p->key_index + f->nkeys]; + bdb_setkeycol (f, 0); ret = DB_GET (p->db[0], &p->key, &p->data, 0); } } @@ -5429,6 +5478,7 @@ indexed_read_next (cob_file *f, const int read_opts) } else { p->key.size = (cob_dbtsize_t) bdb_keylen(f,p->key_index); p->key.data = p->last_readkey[p->key_index]; + bdb_setkeycol (f, p->key_index); ret = DB_SEQ (p->cursor[p->key_index], &p->key, &p->data, DB_SET_RANGE); /* ret != 0 possible, records may be deleted since last read */ if (ret != 0) { @@ -5510,6 +5560,7 @@ indexed_read_next (cob_file *f, const int read_opts) } p->key.data = p->data.data; p->key.size = p->primekeylen; + bdb_setkeycol (f, 0); ret = DB_GET (p->db[0], &p->key, &p->data, 0); if (ret != 0) { bdb_close_index (f, p->key_index); @@ -5636,7 +5687,8 @@ indexed_write (cob_file *f, const int opt) p->last_key = cob_malloc ((size_t)p->maxkeylen); } else if (f->access_mode == COB_ACCESS_SEQUENTIAL - && memcmp (p->last_key, p->key.data, (size_t)p->key.size) > 0) { + && indexed_key_compare (p->last_key, (unsigned char *)p->key.data, (size_t)p->key.size, + (unsigned char *)DBT_GET_APP_DATA(&p->key)) > 0) { return COB_STATUS_21_KEY_INVALID; } memcpy (p->last_key, p->key.data, (size_t)p->key.size); diff --git a/tests/testsuite.src/run_file.at b/tests/testsuite.src/run_file.at index 2ce70bc84..e6b66568a 100644 --- a/tests/testsuite.src/run_file.at +++ b/tests/testsuite.src/run_file.at @@ -12429,6 +12429,425 @@ AT_CHECK([diff reference prog.out], [0], [], []) AT_CLEANUP +# This is only supported by the BDB backend +AT_SETUP([INDEXED file manipulation under ASCII/EBCDIC collation]) +AT_KEYWORDS([runfile WRITE DELETE READ EBCDIC]) + +AT_SKIP_IF([test "$COB_HAS_ISAM" != "db"]) + +AT_DATA([prog.cpy], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + + ENVIRONMENT DIVISION. + + CONFIGURATION SECTION. + OBJECT-COMPUTER. + PROGRAM COLLATING SEQUENCE IS DISORDERED. + SPECIAL-NAMES. + ALPHABET DISORDERED IS "WVUTSRJIHGFEDCB". + + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT MY-FILE ASSIGN TO "testfile" + ORGANIZATION IS INDEXED + ACCESS IS DYNAMIC + FILE-COLSEQ + KEY-COLSEQ + RECORD KEY IS MY-PKEY + ALTERNATE RECORD KEY IS MY-AKEY1 WITH DUPLICATES + ALTERNATE RECORD KEY IS MY-AKEY2 WITH DUPLICATES. + + DATA DIVISION. + + FILE SECTION. + FD MY-FILE. + 01 MY-REC. + 05 MY-PKEY PIC X(3). + 05 MY-AKEY1 PIC X(3). + 05 MY-AKEY2 BINARY-LONG. + 05 MY-DATA PIC 9. + + WORKING-STORAGE SECTION. + 01 DONE-READING PIC 9. + + PROCEDURE DIVISION. + + OPEN OUTPUT MY-FILE + + DISPLAY "WRITING DATA" + + MOVE "CCC" TO MY-PKEY + MOVE "888" TO MY-AKEY1 + MOVE 43 TO MY-AKEY2 + MOVE 1 TO MY-DATA + WRITE MY-REC + + MOVE "ZZZ" TO MY-PKEY + MOVE "AAA" TO MY-AKEY1 + MOVE 40 TO MY-AKEY2 + MOVE 2 TO MY-DATA + WRITE MY-REC + + MOVE "DDD" TO MY-PKEY + MOVE "777" TO MY-AKEY1 + MOVE 42 TO MY-AKEY2 + MOVE 3 TO MY-DATA + WRITE MY-REC + + MOVE "XXX" TO MY-PKEY + MOVE "VVV" TO MY-AKEY1 + MOVE 42 TO MY-AKEY2 + MOVE 4 TO MY-DATA + WRITE MY-REC + + MOVE "666" TO MY-PKEY + MOVE "AAA" TO MY-AKEY1 + MOVE 41 TO MY-AKEY2 + MOVE 5 TO MY-DATA + WRITE MY-REC + + MOVE "222" TO MY-PKEY + MOVE "555" TO MY-AKEY1 + MOVE 44 TO MY-AKEY2 + MOVE 6 TO MY-DATA + WRITE MY-REC + + CLOSE MY-FILE + + + OPEN I-O MY-FILE + + DISPLAY "DELETING DATA" + + MOVE "ZZZ" TO MY-PKEY + DELETE MY-FILE + + MOVE "XXX" TO MY-PKEY + DELETE MY-FILE + + CLOSE MY-FILE + + + OPEN INPUT MY-FILE + + DISPLAY "READING BY PKEY" + + MOVE 0 TO DONE-READING + MOVE SPACES TO MY-PKEY + START MY-FILE KEY >= MY-PKEY + + PERFORM UNTIL NOT DONE-READING = 0 + READ MY-FILE NEXT + AT END MOVE 1 TO DONE-READING + END-READ + IF DONE-READING = 0 + DISPLAY MY-PKEY " " MY-AKEY1 + " " MY-AKEY2 " " MY-DATA + END-IF + END-PERFORM + + DISPLAY "READING BY AKEY1" + + MOVE 0 TO DONE-READING + MOVE SPACES TO MY-AKEY1 + START MY-FILE KEY >= MY-AKEY1 + + PERFORM UNTIL NOT DONE-READING = 0 + READ MY-FILE NEXT + AT END MOVE 1 TO DONE-READING + END-READ + IF DONE-READING = 0 + DISPLAY MY-PKEY " " MY-AKEY1 + " " MY-AKEY2 " " MY-DATA + END-IF + END-PERFORM + + DISPLAY "READING BY AKEY2" + + MOVE 0 TO DONE-READING + MOVE ZERO TO MY-AKEY2 + START MY-FILE KEY >= MY-AKEY2 + + PERFORM UNTIL NOT DONE-READING = 0 + READ MY-FILE NEXT + AT END MOVE 1 TO DONE-READING + END-READ + IF DONE-READING = 0 + DISPLAY MY-PKEY " " MY-AKEY1 + " " MY-AKEY2 " " MY-DATA + END-IF + END-PERFORM + + CLOSE MY-FILE + + + DISPLAY "DONE" + + STOP RUN. +]) + +AT_DATA([reference_ascii], +[WRITING DATA +DELETING DATA +READING BY PKEY +222 555 +0000000044 6 +666 AAA +0000000041 5 +CCC 888 +0000000043 1 +DDD 777 +0000000042 3 +READING BY AKEY1 +222 555 +0000000044 6 +DDD 777 +0000000042 3 +CCC 888 +0000000043 1 +666 AAA +0000000041 5 +READING BY AKEY2 +666 AAA +0000000041 5 +DDD 777 +0000000042 3 +CCC 888 +0000000043 1 +222 555 +0000000044 6 +DONE +]) + +AT_DATA([reference_ascii_ebcdic], +[WRITING DATA +DELETING DATA +READING BY PKEY +222 555 +0000000044 6 +666 AAA +0000000041 5 +CCC 888 +0000000043 1 +DDD 777 +0000000042 3 +READING BY AKEY1 +666 AAA +0000000041 5 +222 555 +0000000044 6 +DDD 777 +0000000042 3 +CCC 888 +0000000043 1 +READING BY AKEY2 +666 AAA +0000000041 5 +DDD 777 +0000000042 3 +CCC 888 +0000000043 1 +222 555 +0000000044 6 +DONE +]) + +AT_DATA([reference_ebcdic], +[WRITING DATA +DELETING DATA +READING BY PKEY +CCC 888 +0000000043 1 +DDD 777 +0000000042 3 +222 555 +0000000044 6 +666 AAA +0000000041 5 +READING BY AKEY1 +666 AAA +0000000041 5 +222 555 +0000000044 6 +DDD 777 +0000000042 3 +CCC 888 +0000000043 1 +READING BY AKEY2 +666 AAA +0000000041 5 +DDD 777 +0000000042 3 +CCC 888 +0000000043 1 +222 555 +0000000044 6 +DONE +]) + +AT_DATA([reference_ebcdic_ascii], +[WRITING DATA +DELETING DATA +READING BY PKEY +CCC 888 +0000000043 1 +DDD 777 +0000000042 3 +222 555 +0000000044 6 +666 AAA +0000000041 5 +READING BY AKEY1 +222 555 +0000000044 6 +DDD 777 +0000000042 3 +CCC 888 +0000000043 1 +666 AAA +0000000041 5 +READING BY AKEY2 +666 AAA +0000000041 5 +DDD 777 +0000000042 3 +CCC 888 +0000000043 1 +222 555 +0000000044 6 +DONE +]) + +# 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([$COBCRUN_DIRECT ./prog1 1>prog1.out], [0], [], []) +AT_CHECK([diff reference_ascii prog1.out], [0], [], []) + +# Testing ASCII file collating sequence using flag +AT_DATA([prog2.cob], [ + COPY "prog.cpy" REPLACING + ==FILE-COLSEQ== BY ==== + ==KEY-COLSEQ== BY ====. +]) +AT_CHECK([$COMPILE -Wno-unfinished -fdefault-file-colseq=ASCII prog2.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog2 1>prog2.out], [0], [], []) +AT_CHECK([diff reference_ascii prog2.out], [0], [], []) + + +# Testing ASCII file collating sequence + EBCDIC key collating sequence using clauses +AT_DATA([prog3.cob], [ + COPY "prog.cpy" REPLACING + ==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([$COBCRUN_DIRECT ./prog3 1>prog3.out], [0], [], []) +AT_CHECK([diff reference_ascii_ebcdic prog3.out], [0], [], []) + +# Testing ASCII file collating sequence using flag + EBCDIC key collating sequence using clause +AT_DATA([prog4.cob], [ + COPY "prog.cpy" REPLACING + ==FILE-COLSEQ== BY ==== + ==KEY-COLSEQ== BY ==COLLATING SEQUENCE OF MY-AKEY1 IS EBCDIC==. +]) +AT_CHECK([$COMPILE -Wno-unfinished -fdefault-file-colseq=ASCII prog4.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog4 1>prog4.out], [0], [], []) +AT_CHECK([diff reference_ascii_ebcdic prog4.out], [0], [], []) + +# Testing EBCDIC file collating sequence using clause +AT_DATA([prog5.cob], [ + COPY "prog.cpy" REPLACING + ==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([$COBCRUN_DIRECT ./prog5 1>prog5.out], [0], [], []) +AT_CHECK([diff reference_ebcdic prog5.out], [0], [], []) + +# Testing EBCDIC file collating sequence using flag +AT_DATA([prog6.cob], [ + COPY "prog.cpy" REPLACING + ==FILE-COLSEQ== BY ==== + ==KEY-COLSEQ== BY ====. +]) +AT_CHECK([$COMPILE -Wno-unfinished -fdefault-file-colseq=EBCDIC prog6.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog6 1>prog6.out], [0], [], []) +AT_CHECK([diff reference_ebcdic prog6.out], [0], [], []) + +# Testing EBCDIC file collating sequence + ASCII key collating sequence using clauses +AT_DATA([prog7.cob], [ + COPY "prog.cpy" REPLACING + ==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([$COBCRUN_DIRECT ./prog7 1>prog7.out], [0], [], []) +AT_CHECK([diff reference_ebcdic_ascii prog7.out], [0], [], []) + +# Testing EBCDIC file collating sequence using flag + ASCII key collating sequence using clause +AT_DATA([prog8.cob], [ + COPY "prog.cpy" REPLACING + ==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([$COBCRUN_DIRECT ./prog8 1>prog8.out], [0], [], []) +AT_CHECK([diff reference_ebcdic_ascii prog8.out], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([INDEXED file numeric keys ordering]) +AT_KEYWORDS([runfile]) + +# BUG: non-display numeric keys are currently ordered lexicographically +# with respect to their binary representation, which is incorrect. +# Could be fixed with a custom comparison function (BDB) +# or using key types other than CHARTYPE (ISAM). +AT_XFAIL_IF([true]) + +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-PKEY. + + DATA DIVISION. + FILE SECTION. + FD MY-FILE. + 01 MY-REC. + 05 MY-PKEY BINARY-LONG. + 05 MY-DATA PIC 9. + + WORKING-STORAGE SECTION. + 01 DONE-READING PIC 9. + + PROCEDURE DIVISION. + + OPEN OUTPUT MY-FILE + + DISPLAY "WRITING DATA" + + MOVE 255 TO MY-PKEY + MOVE 1 TO MY-DATA + WRITE MY-REC + + MOVE 256 TO MY-PKEY + MOVE 2 TO MY-DATA + WRITE MY-REC + + MOVE 65535 TO MY-PKEY + MOVE 3 TO MY-DATA + WRITE MY-REC + + MOVE 65536 TO MY-PKEY + MOVE 4 TO MY-DATA + WRITE MY-REC + + CLOSE MY-FILE + + + OPEN INPUT MY-FILE + + DISPLAY "READING BY PKEY" + + MOVE 0 TO DONE-READING + MOVE 0 TO MY-PKEY + START MY-FILE KEY >= MY-PKEY + + PERFORM UNTIL NOT DONE-READING = 0 + READ MY-FILE NEXT + AT END MOVE 1 TO DONE-READING + END-READ + IF DONE-READING = 0 + DISPLAY MY-PKEY " " MY-DATA + END-IF + END-PERFORM + + CLOSE MY-FILE + + DISPLAY "DONE" WITH NO ADVANCING + + STOP RUN. +]) + +AT_CHECK([$COMPILE prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], +[WRITING DATA +READING BY PKEY ++0000000255 1 ++0000000256 2 ++0000065535 3 ++0000065536 4 +DONE], []) + +AT_CLEANUP + + AT_SETUP([TURN EC-I-O]) AT_KEYWORDS([runfile directive])