From 106e7ce6c98c88bad50e7882a753db165065895f Mon Sep 17 00:00:00 2001 From: ddeclerck Date: Tue, 20 Feb 2024 08:22:08 +0000 Subject: [PATCH 1/5] FR #459: support COLLATING SEQUENCE clause on SELECT / INDEXED files (currently only for the BDB backend) cobc: * 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 libcob: * 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 --- NEWS | 6 + cobc/ChangeLog | 13 + cobc/cobc.c | 50 ++-- cobc/codegen.c | 39 +++ 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 | 56 ++++- tests/testsuite.src/run_file.at | 419 ++++++++++++++++++++++++++++++++ 14 files changed, 663 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..c7dd66d17 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -9271,6 +9271,39 @@ 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) +{ + 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)) { + 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 +9364,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 +9389,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..f37ea8991 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"); /* only implemented for BDB */ } ; @@ -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"); /* only implemented for BDB */ } ; 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 492b5f6e3..5f7f8b9ea 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 + 2024-01-19 Simon Sobisch * fileio.c (indexed_keylen): signature change to directly take the keydesc 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 7272878f7..9e2a094c1 100644 --- a/libcob/fileio.c +++ b/libcob/fileio.c @@ -689,6 +689,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; @@ -755,6 +765,13 @@ bdb_savekey (cob_file *f, unsigned char *keyarea, unsigned char *record, int idx return (int)f->keys[idx].field->size; } +static COB_INLINE 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) { @@ -765,6 +782,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'. @@ -3901,6 +3919,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); } @@ -4003,6 +4022,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); @@ -4142,6 +4162,32 @@ 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); + /* LCOV_EXCL_START */ + if (col == NULL) { + cob_runtime_error ("bdb_bt_compare was set but no collating sequence was stored in DBT"); + } + if (k1->size != k2->size) { + cob_runtime_error ("bdb_bt_compare was given keys of different length"); + } + /* LCOV_EXCL_STOP */ + return indexed_key_compare(k1->data, k2->data, k2->size, col); +} + /* OPEN INDEXED file */ static int @@ -4612,6 +4658,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; @@ -5378,6 +5427,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) { @@ -5403,6 +5453,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); } } @@ -5428,6 +5479,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) { @@ -5509,6 +5561,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); @@ -5635,7 +5688,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 2126dec17..ed9351e01 100644 --- a/tests/testsuite.src/run_file.at +++ b/tests/testsuite.src/run_file.at @@ -12430,6 +12430,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]) From 93d5877e42b1dea360c5d2fce98765fbe55b7f01 Mon Sep 17 00:00:00 2001 From: sf-mensch Date: Thu, 25 Jan 2024 13:55:53 +0000 Subject: [PATCH 2/5] follow-up to r5208 "header include" presumingly fixing win32 tests --- doc/gnucobol.texi | 8 ++++---- tests/testsuite.src/used_binaries.at | 6 +++--- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/doc/gnucobol.texi b/doc/gnucobol.texi index 7aa0abd4c..41127428a 100644 --- a/doc/gnucobol.texi +++ b/doc/gnucobol.texi @@ -66,7 +66,7 @@ together with a designated C compiler and linker. This manual corresponds to GnuCOBOL @value{VERSION}. @page @vskip 0pt plus 1filll -Copyright @copyright{} 2002-2012, 2014-2023 Free Software Foundation, Inc.@* +Copyright @copyright{} 2002-2012, 2014-2024 Free Software Foundation, Inc.@* Written by Keisuke Nishida, Roger While, Brian Tiffin, Simon Sobisch. @insertcopying @@ -1597,7 +1597,7 @@ enum cob_runtime_option_switch @{ COB_SET_RUNTIME_RESCAN_ENV /* rescan environment variables */ COB_SET_RUNTIME_DISPLAY_PUNCH_FILE /* 'p' is FILE * */ @}; -COB_EXPIMP void cob_set_runtime_option (enum cob_runtime_option_switch opt, void *p); +COB_EXT_IMPORT void cob_set_runtime_option (enum cob_runtime_option_switch opt, void *p); @end smallexample So from you C code you can tell the GnuCOBOL runtime to redirect TRACE output by: @@ -1620,7 +1620,7 @@ cob_set_runtime_option (COB_SET_RUNTIME_DISPLAY_PUNCH_FILE, Another routine can be used to return the current value of the option. @example -COB_EXPIMP void * +COB_EXT_IMPORT void * cob_get_runtime_option (enum cob_runtime_option_switch opt); @end example @@ -1631,7 +1631,7 @@ When an EBCDIC/ASCII translation table is needed (for instance when calling sort functions), you can can call the @code{cob_load_collation} function to retrieve such tables: @example -COB_EXPIMP int +COB_EXT_IMPORT int cob_load_collation (const char *col_name, cob_u8_t *ebcdic_to_ascii, cob_u8_t *ascii_to_ebcdic) diff --git a/tests/testsuite.src/used_binaries.at b/tests/testsuite.src/used_binaries.at index 817d61c50..d7266092e 100644 --- a/tests/testsuite.src/used_binaries.at +++ b/tests/testsuite.src/used_binaries.at @@ -1,4 +1,4 @@ -## Copyright (C) 2014-2023 Free Software Foundation, Inc. +## Copyright (C) 2014-2024 Free Software Foundation, Inc. ## Written by Simon Sobisch, Brian Tiffin ## ## This file is part of GnuCOBOL. @@ -1083,10 +1083,10 @@ AT_CLEANUP AT_SETUP([check include header file]) -AT_KEYWORDS([-include]) +#AT_KEYWORDS([include]) AT_DATA([file.h], [ -extern void f(char *, long ); +COB_EXT_IMPORT void f (char *, long); ]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. From f9596f55fe49c96f278d228db05306bf1042b43f Mon Sep 17 00:00:00 2001 From: sf-mensch Date: Thu, 25 Jan 2024 14:14:37 +0000 Subject: [PATCH 3/5] fixing compilation of [r5215] - [feature-requests:#459] COLLATING SEQUENCE for [!WITH_DB] --- libcob/fileio.c | 54 +++++++++++++++++++++++++------------------------ 1 file changed, 28 insertions(+), 26 deletions(-) diff --git a/libcob/fileio.c b/libcob/fileio.c index 9e2a094c1..0670d792a 100644 --- a/libcob/fileio.c +++ b/libcob/fileio.c @@ -301,7 +301,7 @@ indexed_keydesc (cob_file *f, struct keydesc *kd, cob_file_key *key) } /* LCOV_EXCL_STOP */ keylen = 0; - for (part=0; part < key->count_components; part++) { + for (part = 0; part < key->count_components; part++) { struct keypart *k_part = &kd->k_part[part]; k_part->kp_start = key->component[part]->data - f->record->data; k_part->kp_leng = key->component[part]->size; @@ -725,6 +725,18 @@ struct indexed_file { DB_LOCK bdb_record_lock; }; +/* collation aware key comparision, + currently only used for BDB, likely used in general later */ +static int +indexed_key_compare (const unsigned char *k1, const unsigned char *k2, + size_t sz, const unsigned char *col) +{ + if (col) { + return cob_cmps (k1, k2, sz, col); + } + return memcmp (k1, k2, sz); +} + /* Return total length of the key */ static int bdb_keylen (cob_file *f, int idx) @@ -899,6 +911,21 @@ bdb_close_index (cob_file *f, int index) return 1; } +static int +bdb_bt_compare (DB *db, const DBT *k1, const DBT *k2) +{ + const unsigned char *col = (unsigned char *)DBT_GET_APP_DATA(k1); + /* LCOV_EXCL_START */ + if (col == NULL) { + cob_runtime_error ("bdb_bt_compare was set but no collating sequence was stored in DBT"); + } + if (k1->size != k2->size) { + cob_runtime_error ("bdb_bt_compare was given keys of different length"); + } + /* LCOV_EXCL_STOP */ + return indexed_key_compare (k1->data, k2->data, k2->size, col); +} + #endif /* WITH_DB */ @@ -4162,31 +4189,6 @@ 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); - /* LCOV_EXCL_START */ - if (col == NULL) { - cob_runtime_error ("bdb_bt_compare was set but no collating sequence was stored in DBT"); - } - if (k1->size != k2->size) { - cob_runtime_error ("bdb_bt_compare was given keys of different length"); - } - /* LCOV_EXCL_STOP */ - return indexed_key_compare(k1->data, k2->data, k2->size, col); -} /* OPEN INDEXED file */ From e36a124b2b7247b0b9bcded694ac3e007e461a01 Mon Sep 17 00:00:00 2001 From: lefessan Date: Wed, 31 Jan 2024 18:06:56 +0000 Subject: [PATCH 4/5] Add options --copy COPYBOOK and --include HEADER to cobc The --copy option can be used to include copybooks before parsing files, for example to perform replacements or include COBOL prototypes. The --include option can be used to include a HEADER in the generated C file, for example to perform verification of external calls combined with -fstatic-call. --- NEWS | 10 +++++ cobc/ChangeLog | 14 +++++++ cobc/cobc.c | 54 ++++++++++++++++++++++--- cobc/cobc.h | 3 ++ cobc/codegen.c | 11 ++++++ cobc/flag.def | 2 +- cobc/help.c | 4 ++ cobc/pplex.l | 59 +++++++++++++++++++++------- cobc/replace.c | 19 ++++++++- doc/gnucobol.texi | 18 ++++++++- tests/testsuite.src/syn_copy.at | 47 ++++++++++++++++++++++ tests/testsuite.src/used_binaries.at | 58 +++++++++++++++++++++++++++ 12 files changed, 276 insertions(+), 23 deletions(-) diff --git a/NEWS b/NEWS index e7480c254..55977763f 100644 --- a/NEWS +++ b/NEWS @@ -22,6 +22,16 @@ NEWS - user visible changes -*- outline -*- * Changes to the COBOL compiler (cobc) options: +** New option --copy COPYBOOK to load copybooks before parsing files. This + option can typically be used to perform replacements without modifying + the source code, or to add prototypes for external calls. + +** New option --include FILE.h to add a #include in the generated C file. + This option can typically be used to force the C compiler to check static + calls to externals. The files are put into quotes, unless they start by + '<'. Quoted files are expected to have absolute paths, as the C compiler + is called in a temp directory instead of the project directory. + ** output of unlimited errors may be requested by -fmax-errors=0, to stop compiliation at first error use -Wfatal-errors ** default value for -fmax-errors was changed from 128 to 20 diff --git a/cobc/ChangeLog b/cobc/ChangeLog index d249d3f50..4beeb50c3 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,4 +1,18 @@ +2023-10-12 Fabrice Le Fessant + + * cobc.c, codegen.c: new option --include FILE, to #include + additional files in the C generated code. Such files can be + used to statically check the number of arguments in static + calls, for example. The files are put into quotes, unless + they start by '<'. Since C files are compiled in a temp dir, + quoted files should be absolute paths. Implementing FR #176 + +2023-10-11 Fabrice Le Fessant + + * cobc.c, pplex.l: new option --copy COPYBOOK, to include a COPYBOOK + before reading the source file + 2023-11-29 Fabrice Le Fessant * cobc.c (cobc_clean_up): when save-temps specifies a directory, diff --git a/cobc/cobc.c b/cobc/cobc.c index 57f254cfb..5285e3b7f 100644 --- a/cobc/cobc.c +++ b/cobc/cobc.c @@ -105,7 +105,9 @@ enum compile_level { #define CB_FLAG_GETOPT_NO_DUMP 13 #define CB_FLAG_GETOPT_EBCDIC_TABLE 14 #define CB_FLAG_GETOPT_DEFAULT_COLSEQ 15 -#define CB_FLAG_MEMORY_CHECK 16 +#define CB_FLAG_GETOPT_MEMORY_CHECK 16 +#define CB_FLAG_GETOPT_COPY_FILE 17 +#define CB_FLAG_GETOPT_INCLUDE_FILE 18 /* Info display limits */ @@ -171,8 +173,8 @@ enum compile_level { #define GC_C_VERSION _("unknown") #endif -#define CB_TEXT_LIST_ADD(y,z) y = cb_text_list_add (y, z) -#define CB_TEXT_LIST_CHK(y,z) y = cb_text_list_chk (y, z) +#define CB_TEXT_LIST_ADD(list,z) list = cb_text_list_add (list, z) +#define CB_TEXT_LIST_CHK(list,z) list = cb_text_list_chk (list, z) #ifdef _MSC_VER #define CB_COPT_0 " /Od" @@ -232,6 +234,8 @@ const char *cb_cobc_build_stamp = NULL; const char *demangle_name = NULL; const char *cb_storage_file_name = NULL; const char *cb_call_extfh = NULL; +struct cb_text_list *cb_copy_list = NULL; +struct cb_text_list *cb_include_file_list = NULL; struct cb_text_list *cb_include_list = NULL; struct cb_text_list *cb_depend_list = NULL; struct cb_text_list *cb_intrinsic_list = NULL; @@ -595,6 +599,8 @@ static const struct option long_options[] = { {"save-temps", CB_OP_ARG, NULL, '_'}, {"std", CB_RQ_ARG, NULL, '$'}, {"conf", CB_RQ_ARG, NULL, '&'}, + {"copy", CB_RQ_ARG, NULL, CB_FLAG_GETOPT_COPY_FILE}, + {"include", CB_RQ_ARG, NULL, CB_FLAG_GETOPT_INCLUDE_FILE}, {"debug", CB_NO_ARG, NULL, 'd'}, {"ext", CB_RQ_ARG, NULL, 'e'}, /* note: kept *undocumented* until GC4, will be changed to '.' */ {"free", CB_NO_ARG, NULL, 'F'}, /* note: not assigned directly as this is only valid for */ @@ -3282,12 +3288,12 @@ process_command_line (const int argc, char **argv) cobc_wants_debug = 1; break; - case 8: + case CB_FLAG_GETOPT_DUMP: /* 8 */ /* -fdump= : Add sections for dump code generation */ cobc_def_dump_opts (cob_optarg, 1); break; - case 13: + case CB_FLAG_GETOPT_NO_DUMP: /* 13 */ /* -fno-dump= : Suppress sections in dump code generation */ if (cob_optarg) { cobc_def_dump_opts (cob_optarg, 0); @@ -3892,7 +3898,7 @@ process_command_line (const int argc, char **argv) } break; - case CB_FLAG_MEMORY_CHECK: /* 16 */ + case CB_FLAG_GETOPT_MEMORY_CHECK: /* 16 */ /* -fmemory-check= : */ if (!cob_optarg) { cb_flag_memory_check = CB_MEMCHK_ALL; @@ -3901,6 +3907,26 @@ process_command_line (const int argc, char **argv) } break; + case CB_FLAG_GETOPT_COPY_FILE: /* 17 */ + /* --copy= : COPY file at beginning */ + if (strlen (cob_optarg) > (COB_MINI_MAX)) { + cobc_err_exit (COBC_INV_PAR, "--copy"); + } + CB_TEXT_LIST_ADD (cb_copy_list, + cobc_strdup (cob_optarg)); + break; + + case CB_FLAG_GETOPT_INCLUDE_FILE: /* 18 */ + /* -include= : add #include "file.h" to + generated C file */ + if (strlen (cob_optarg) > (COB_MINI_MAX)) { + cobc_err_exit (COBC_INV_PAR, "--include"); + } + CB_TEXT_LIST_ADD (cb_include_file_list, + cobc_strdup (cob_optarg)); + cb_flag_c_decl_for_static_call = 0; + break; + case 'A': /* -A : Add options to C compile phase */ COBC_ADD_STR (cobc_cflags, " ", cob_optarg, NULL); @@ -9266,6 +9292,22 @@ main (int argc, char **argv) finish_setup_compiler_env (); finish_setup_internal_env (); + { + struct cb_text_list *l; + for (l = cb_copy_list; l; l=l->next){ + const char *filename; + int has_ext; + char name[COB_MINI_BUFF]; + int len = strlen (l->text); + memcpy (name, l->text, len+1); + has_ext = (strchr (name, '.') != NULL); + filename = cb_copy_find_file (name, has_ext); + if (!filename){ + cobc_err_exit (_("fatal error: could not find --copy argument %s"), name); + } + } + } + /* Reset source format in case text column has been configured manually. */ cobc_set_source_format (cobc_get_source_format ()); diff --git a/cobc/cobc.h b/cobc/cobc.h index 69ed6e441..7b5f30bbd 100644 --- a/cobc/cobc.h +++ b/cobc/cobc.h @@ -473,6 +473,8 @@ extern FILE *cb_listing_file; extern FILE *cb_src_list_file; extern FILE *cb_depend_file; extern struct cb_text_list *cb_depend_list; +extern struct cb_text_list *cb_copy_list; +extern struct cb_text_list *cb_include_file_list; extern struct cb_text_list *cb_include_list; extern struct cb_text_list *cb_intrinsic_list; extern struct cb_text_list *cb_extension_list; @@ -652,6 +654,7 @@ extern void cb_plex_error (const size_t, const char *, ...) COB_A_FORMAT23; extern unsigned int cb_plex_verify (const size_t, const enum cb_support, const char *); +extern const char *cb_copy_find_file (char *name, int has_ext); extern void configuration_warning (const char *, const int, const char *, ...) COB_A_FORMAT34; extern void configuration_error (const char *, const int, diff --git a/cobc/codegen.c b/cobc/codegen.c index 293e3b4e3..ab323a4f9 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -1829,6 +1829,17 @@ output_gnucobol_defines (const char *formatted_date) current_compile_tm.tm_sec; output_line ("#define COB_MODULE_TIME\t\t%d", i); + { + struct cb_text_list *l = cb_include_file_list ; + for (;l;l=l->next){ + if (l->text[0] == '<'){ + output_line ("#include %s", l->text); + } else { + output_line ("#include \"%s\"", l->text); + } + } + } + } /* CALL cache */ diff --git a/cobc/flag.def b/cobc/flag.def index d362ee99b..ff16d6f3d 100644 --- a/cobc/flag.def +++ b/cobc/flag.def @@ -166,7 +166,7 @@ CB_FLAG (cb_flag_stack_check, 1, "stack-check", _(" -fstack-check PERFORM stack checking\n" " * turned on by --debug/-g")) -CB_FLAG_OP (1, "memory-check", CB_FLAG_MEMORY_CHECK, +CB_FLAG_OP (1, "memory-check", CB_FLAG_GETOPT_MEMORY_CHECK, _(" -fmemory-check= checks for invalid writes to internal storage,\n" " may be one of: all, pointer, using, none\n" " * default: none, set to all by --debug")) diff --git a/cobc/help.c b/cobc/help.c index 4f4dda32b..3e95a2e19 100644 --- a/cobc/help.c +++ b/cobc/help.c @@ -116,7 +116,11 @@ cobc_print_usage_common_options (void) puts (_(" -X, --Xref specify cross reference in listing")); #endif puts (_(" -I add to copy/include search path")); + puts (_(" --copy include at beginning of file,\n" + " as would COPY copybook.")); puts (_(" -L add to library search path")); + puts (_(" --include add a #include \"file.h\" at the beginning of the C\n" + " generated file (implies -fno-gen-c-decl-static-call)")); puts (_(" -l link the library ")); puts (_(" -K generate CALL to as static")); puts (_(" -D define for COBOL compilation")); diff --git a/cobc/pplex.l b/cobc/pplex.l index 1ecf3672b..02bb2640c 100644 --- a/cobc/pplex.l +++ b/cobc/pplex.l @@ -59,19 +59,21 @@ static int ppwrap (void) { return 1; } +static void insert_copy_arg (void); + #define PPLEX_BUFF_LEN 512 #define YY_INPUT(buf,result,max_size) result = ppinput (buf, max_size); #define ECHO fputs (yytext, yyout) +/* The first --copy COPYBOOK is inserted using this macro. The next + ones will be inserted in <>, when we come back to the toplevel + source file. */ #define YY_USER_INIT \ - if (!plexbuff1) { \ - plexbuff1 = cobc_malloc ((size_t)COB_SMALL_BUFF); \ - } \ - if (!plexbuff2) { \ - plexbuff2 = cobc_malloc ((size_t)COB_SMALL_BUFF); \ - } \ requires_listing_line = 1; \ - comment_allowed = 1; + comment_allowed = 1; \ + copy_list_pointer = cb_copy_list; \ + insert_copy_arg (); + #include "config.h" @@ -179,6 +181,20 @@ static void output_pending_newlines (FILE *); static struct cb_text_list *pp_text_list_add (struct cb_text_list *, const char *, const size_t); +static struct cb_text_list *copy_list_pointer = NULL; + +static void insert_copy_arg (void) +{ + if (copy_list_pointer != NULL){ + int ret = ppcopy (copy_list_pointer->text, NULL, NULL); + if ( ret < 0 ){ /* This should never happen, as we already test it before */ + cobc_err_msg (_("fatal error: %s"), "could not find --copy argument"); + cobc_abort_terminate (0); + } + copy_list_pointer = copy_list_pointer->next; + } +} + %} WORD [_0-9A-Z\x80-\xFF-]+ @@ -1205,6 +1221,13 @@ ENDIF_DIRECTIVE_STATE>{ copy_stack = current_copy_info->next; cobc_free (current_copy_info->dname); cobc_free (current_copy_info); + + /* Check whether we are back at the toplevel source file. In this case, + check if there is a pending copy argument (--copy COPYBOOK) waiting + to be inserted. */ + if (copy_stack->next == NULL){ + insert_copy_arg(); + } } %% @@ -1480,6 +1503,10 @@ ppcopy_try_open (const char *dir, const char *name, int has_ext) const char *extension = ""; struct stat st; + if (!plexbuff2) { + plexbuff2 = cobc_malloc ((size_t)COB_SMALL_BUFF); + } + for (;;) { if (dir) { snprintf (plexbuff2, (size_t)COB_SMALL_MAX, "%s%c%s%s", @@ -1520,8 +1547,8 @@ ppcopy_try_open (const char *dir, const char *name, int has_ext) each with all known copybook extensions: 1 - as is 2 - all known copybook directories */ -static const char * -ppcopy_find_file (char *name, int has_ext) +const char * +cb_copy_find_file (char *name, int has_ext) { const char *filename; { @@ -1597,6 +1624,10 @@ ppcopy (const char *name, const char *lib, struct cb_replace_list *replace_list) cb_current_file->copy_line = cb_source_line; } + if (!plexbuff1) { + plexbuff1 = cobc_malloc ((size_t)COB_SMALL_BUFF); + } + /* TODO: open with path relative to the current file's path, if any (applies both to with and without "lib") */ @@ -1620,10 +1651,10 @@ ppcopy (const char *name, const char *lib, struct cb_replace_list *replace_list) snprintf (plexbuff1, (size_t)COB_SMALL_MAX, "%s%c%s", lib_env, SLASH_CHAR, name); plexbuff1[COB_SMALL_MAX] = 0; - filename = ppcopy_find_file (plexbuff1, has_ext); + filename = cb_copy_find_file (plexbuff1, has_ext); } else { strcpy (plexbuff1, name); - filename = ppcopy_find_file (plexbuff1, has_ext); + filename = cb_copy_find_file (plexbuff1, has_ext); } } } @@ -1634,13 +1665,13 @@ ppcopy (const char *name, const char *lib, struct cb_replace_list *replace_list) snprintf (plexbuff1, (size_t)COB_SMALL_MAX, "%s%c%s", lib, SLASH_CHAR, name); plexbuff1[COB_SMALL_MAX] = 0; - filename = ppcopy_find_file (plexbuff1, has_ext); + filename = cb_copy_find_file (plexbuff1, has_ext); } /* try without library name, if not resolved by env */ if (!filename && !lib_env) { strcpy (plexbuff1, name); - filename = ppcopy_find_file (plexbuff1, has_ext); + filename = cb_copy_find_file (plexbuff1, has_ext); if (filename) { cb_plex_warning (COBC_WARN_FILLER, 0, _("copybook not found in library '%s', library-name ignored"), @@ -1656,7 +1687,7 @@ ppcopy (const char *name, const char *lib, struct cb_replace_list *replace_list) } } else { strcpy (plexbuff1, name); - filename = ppcopy_find_file (plexbuff1, has_ext); + filename = cb_copy_find_file (plexbuff1, has_ext); } /* expected case: filename found */ diff --git a/cobc/replace.c b/cobc/replace.c index cabaa372d..6ebe254f3 100644 --- a/cobc/replace.c +++ b/cobc/replace.c @@ -193,6 +193,17 @@ STRING_OF_LIST(token) /* string_of_text_list (...) */ STRING_OF_LIST(text) +static void dump_replacement(struct cb_replacement_state* repls) +{ + fprintf(stderr, "dump_replacement('%s'):\n", repls->name); + struct cb_replace_list *list = repls->replace_list ; + for (;list;list = list->next){ + fprintf(stderr, " replace: %s\n", string_of_text_list (list->src->text_list)); + fprintf(stderr, " by: %s\n", string_of_text_list (list->new_text)); + } + fprintf(stderr, "=================================================================\n"); +} + #endif /* DEBUG_REPLACE */ /* global state */ @@ -759,7 +770,6 @@ cb_free_replace (void) reset_replacements (copy_repls); reset_replacements (replace_repls); #endif - cobc_free (copy_repls); copy_repls = NULL; @@ -772,6 +782,10 @@ cb_free_replace (void) struct cb_replace_list * cb_get_copy_replacing_list (void) { +#ifdef DEBUG_REPLACE_TRACE + fprintf (stderr, "cb_get_copy_replacing_list()\n"); +#endif + if (copy_repls == NULL) { #ifdef DEBUG_REPLACE_TRACE int i; @@ -845,4 +859,7 @@ cb_set_replace_list (struct cb_replace_list *list, const int is_pushpop) if (cb_src_list_file) { cb_set_print_replace_list (list); } +#ifdef DEBUG_REPLACE_TRACE + dump_replacement(replace_repls); +#endif } diff --git a/doc/gnucobol.texi b/doc/gnucobol.texi index 0ed1f9f0a..7aa0abd4c 100644 --- a/doc/gnucobol.texi +++ b/doc/gnucobol.texi @@ -365,10 +365,26 @@ The following options specify the target type produced by the compiler: @table @code @item -E Preprocess only: compiler directives are executed, comment lines are -removed and @code{COPY} statements are expanded. +removed, and @code{COPY} and @code{REPLACE} statements are performed. The output is sent to stdout, allowing you to directly use it as input for another process. You can manually set an output file using @option{-o}. +@item --copy @var{copybook} +Include @file{copybook} at the beginning of the source code, as if +@code{COPY copybook} had been parsed. + +@item --include @var{file.h} +Add a @code{#include} @file{file.h} at the beginning of the generated +C source file. The file name is put into quotes, unless it starts by +@code{<}. Quoted files should be absolute paths, since C files are compiled +in temporary directories. +The option also implies @option{-fno-gen-c-decl-static-call}. +This option can be used to check function prototypes when +static calls are used. When this option is used, the source file is +compiled in the project directory (instead of the temp directory), and +no prototypes are generated, so ALL static call functions must appear +in the header file, with GnuCOBOL compatible types. + @item -C Translation only. COBOL source files are translated into C files. The output is saved in file @file{*.c}. diff --git a/tests/testsuite.src/syn_copy.at b/tests/testsuite.src/syn_copy.at index 0ac0784b2..ad1550a18 100644 --- a/tests/testsuite.src/syn_copy.at +++ b/tests/testsuite.src/syn_copy.at @@ -1072,3 +1072,50 @@ AT_DATA([prog.cob], [ AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) AT_CLEANUP + + +AT_SETUP([Option --copy COPYBOOK]) +AT_KEYWORDS([argument]) + +AT_DATA([copybook1.CPY], [ + REPLACE ==BEGIN PROGRAM== BY ==IDENTIFICATION DIVISION. + PROGRAM-ID.==. +]) +AT_DATA([copybook2.CPY], [ + REPLACE ALSO ==output== BY =="Hello world"==. +]) +AT_DATA([copybook3.CPY], [ + REPLACE ALSOO ==output== BY =="Hello world"==. +]) +AT_DATA([prog.cob], [ + BEGIN PROGRAM prog. + PROCEDURE DIVISION. + DISPLAY output + STOP RUN. +]) + +AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], +[prog.cob:2: error: PROGRAM-ID header missing +prog.cob:2: error: ENVIRONMENT DIVISION header missing +prog.cob:2: error: CONFIGURATION SECTION header missing +prog.cob:2: error: SPECIAL-NAMES header missing +prog.cob:2: error: invalid system-name 'BEGIN' +prog.cob:2: error: syntax error, unexpected PROGRAM, expecting CRT or Identifier +prog.cob:2: error: invalid system-name 'prog' +prog.cob:2: error: syntax error, unexpected ., expecting CRT or Identifier +prog.cob:3: error: syntax error, unexpected PROCEDURE +prog.cob:4: error: PROCEDURE DIVISION header missing +]) + +AT_CHECK([$COMPILE_ONLY --copy copybook1 --copy copybook2 prog.cob], [0], [], []) + +AT_CHECK([$COMPILE_ONLY --copy copybook1 --copy copybook3 prog.cob], [1], [], +[copybook3.CPY:2: error: syntax error, unexpected ==, expecting BY +copybook3.CPY:2: error: PROGRAM-ID header missing +]) + +AT_CHECK([$COMPILE_ONLY --copy copybook1 --copy copybook4 prog.cob], [1], [], +[cobc: error: fatal error: could not find --copy argument copybook4 +]) + +AT_CLEANUP diff --git a/tests/testsuite.src/used_binaries.at b/tests/testsuite.src/used_binaries.at index b99b7e6f4..817d61c50 100644 --- a/tests/testsuite.src/used_binaries.at +++ b/tests/testsuite.src/used_binaries.at @@ -1081,3 +1081,61 @@ HOME/prog.cob:14: warning: ignoring redundant . AT_CLEANUP + +AT_SETUP([check include header file]) +AT_KEYWORDS([-include]) + +AT_DATA([file.h], [ +extern void f(char *, long ); +]) +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + PROCEDURE DIVISION. + CALL "f" USING "Hello". +]) + +# No check, program seems correct + +AT_CHECK([$COBC -m -fstatic-call prog.cob], [0], [], []) + +# We ignore the error output, as it depends on the C compiler in use + +AT_CHECK([$COBC -m --include "$PWD/file.h" -fstatic-call prog.cob], [1], [], [ignore]) +AT_DATA([prog2.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 long USAGE BINARY-C-LONG. + PROCEDURE DIVISION. + CALL "f" USING "Hello" BY VALUE long RETURNING NOTHING. +]) + +AT_CHECK([$COBC -m --include "$PWD/file.h" -fstatic-call prog2.cob], [0], [], []) + +AT_CHECK([$COBC -I . -m --include "file.h" -fstatic-call prog2.cob], [0], [], []) + +# We can use --copy to check a CALL against a prototype. However, this +# feature is not fully supported by GnuCOBOL yet, so we get some +# warnings. For exemple: +# * not putting RETURNING triggers an error +# * putting RETURNING NOTHING is not supported +# * putting RETURNING OMITTED is ok, but triggers a warning (see stderr) + +AT_DATA([f.copy], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. f PROTOTYPE. + DATA DIVISION. + LINKAGE SECTION. + 01 a PIC X(20). + 01 b BINARY-C-LONG. + PROCEDURE DIVISION USING a BY VALUE b RETURNING OMITTED. + END PROGRAM f. +]) + +AT_CHECK([$COMPILE_MODULE -Wno-unfinished --copy "f.copy" -fstatic-call prog2.cob], [0], [], +[prog2.cob:8: warning: unexpected RETURNING item +]) + +AT_CLEANUP From 300b542f3caab9dac639e3eb62f60fdedb6c10a2 Mon Sep 17 00:00:00 2001 From: sf-mensch Date: Fri, 16 Feb 2024 22:42:27 +0000 Subject: [PATCH 5/5] fileio refactoring libcob/fileio.c: * (indexed_keylen): signature change to directly take the keydesc * [WITH_ANY_ISAM]: refactored to ease access to keydesc and keypart * (indexed_open) [WITH_ANY_ISAM]: refactored --- libcob/ChangeLog | 10 +- libcob/fileio.c | 320 ++++++++++++++++---------------- tests/testsuite.src/run_file.at | 63 +++---- 3 files changed, 199 insertions(+), 194 deletions(-) diff --git a/libcob/ChangeLog b/libcob/ChangeLog index fe972dd3b..492b5f6e3 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -1,4 +1,10 @@ +2024-01-19 Simon Sobisch + + * fileio.c (indexed_keylen): signature change to directly take the keydesc + * fileio.c [WITH_ANY_ISAM]: refactored to ease access to keydesc and keypart + * fileio.c (indexed_open) [WITH_ANY_ISAM]: refactored + 2023-12-14 David Declerck * common.c (cob_terminate_routines, cob_call_with_exception_check): @@ -596,7 +602,7 @@ after suggestions by Chuck Haatvedt * fileio.c (open_next): set binary file mode, minor refactoring * fileio.c (cob_file_close) [_WIN32]: don't try to unlock invalid file handles; mark file descriptor as closed when file handle was closed - + 2023-02-06 Simon Sobisch * numeric.c (cob_decimal_get_packed, cob_decimal_get_display): @@ -6239,7 +6245,7 @@ after suggestions by Chuck Haatvedt * call.c, common.c, move.c, Makefile.am: gettextized -Copyright 2002-2023 Free Software Foundation, Inc. +Copyright 2002-2024 Free Software Foundation, Inc. Copying and distribution of this file, with or without modification, are permitted provided the copyright notice and this notice are preserved. diff --git a/libcob/fileio.c b/libcob/fileio.c index 4a644e1fe..7272878f7 100644 --- a/libcob/fileio.c +++ b/libcob/fileio.c @@ -1,5 +1,5 @@ /* - Copyright (C) 2002-2012, 2014-2023 Free Software Foundation, Inc. + Copyright (C) 2002-2012, 2014-2024 Free Software Foundation, Inc. Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman This file is part of GnuCOBOL. @@ -191,12 +191,12 @@ struct indexfile { /* Return total length of the key */ static int -indexed_keylen (struct indexfile *fh, int idx) +indexed_keylen (const struct keydesc *key) { int totlen, part; totlen = 0; - for (part = 0; part < fh->key[idx].k_nparts; part++) { - totlen += fh->key[idx].k_part[part].kp_leng; + for (part = 0; part < key->k_nparts; part++) { + totlen += key->k_part[part].kp_leng; } return totlen; } @@ -206,16 +206,16 @@ indexed_keylen (struct indexfile *fh, int idx) static int indexed_savekey (struct indexfile *fh, unsigned char *data, int idx) { - int totlen, part; - totlen = 0; + const struct keydesc *key = &fh->key[idx]; + int totlen = 0; + int part; if (data == NULL) { data = (unsigned char*)fh->recwrk; } - for (part = 0; part < fh->key[idx].k_nparts; part++) { - memcpy (fh->savekey + totlen, - data + fh->key[idx].k_part[part].kp_start, - fh->key[idx].k_part[part].kp_leng); - totlen += fh->key[idx].k_part[part].kp_leng; + for (part = 0; part < key->k_nparts; part++) { + const struct keypart *k_part = &key->k_part[part]; + memcpy (fh->savekey + totlen, data + k_part->kp_start, k_part->kp_leng); + totlen += k_part->kp_leng; } return totlen; } @@ -225,16 +225,16 @@ indexed_savekey (struct indexfile *fh, unsigned char *data, int idx) static int indexed_restorekey (struct indexfile *fh, unsigned char *data, int idx) { + const struct keydesc *key = &fh->key[idx]; int totlen, part; totlen = 0; if (data == NULL) { data = (unsigned char*)fh->recwrk; } - for (part = 0; part < fh->key[idx].k_nparts; part++) { - memcpy (data + fh->key[idx].k_part[part].kp_start, - fh->savekey + totlen, - fh->key[idx].k_part[part].kp_leng); - totlen += fh->key[idx].k_part[part].kp_leng; + for (part = 0; part < key->k_nparts; part++) { + const struct keypart *k_part = &key->k_part[part]; + memcpy (data + k_part->kp_start, fh->savekey + totlen, k_part->kp_leng); + totlen += k_part->kp_leng; } return totlen; } @@ -244,20 +244,21 @@ indexed_restorekey (struct indexfile *fh, unsigned char *data, int idx) static int indexed_cmpkey (struct indexfile *fh, unsigned char *data, int idx, int partlen) { - int sts, part, totlen,cl; + const struct keydesc *key = &fh->key[idx]; + int sts, part, totlen; totlen = sts = 0; if (partlen <= 0) { - partlen = indexed_keylen(fh, idx); + partlen = indexed_keylen (key); } - for (part = 0; part < fh->key[idx].k_nparts && partlen > 0; part++) { - cl = partlen > fh->key[idx].k_part[part].kp_leng ? fh->key[idx].k_part[part].kp_leng : partlen; - sts = memcmp( data + fh->key[idx].k_part[part].kp_start, - fh->savekey + totlen, cl); + for (part = 0; part < key->k_nparts && partlen > 0; part++) { + const struct keypart *k_part = &key->k_part[part]; + const int cl = partlen > k_part->kp_leng ? k_part->kp_leng : partlen; + sts = memcmp (data + k_part->kp_start, fh->savekey + totlen, cl); if (sts != 0) { return sts; } - totlen += fh->key[idx].k_part[part].kp_leng; - partlen -= fh->key[idx].k_part[part].kp_leng; + totlen += k_part->kp_leng; + partlen -= k_part->kp_leng; } return sts; } @@ -267,7 +268,7 @@ indexed_cmpkey (struct indexfile *fh, unsigned char *data, int idx, int partlen) static int indexed_keydesc (cob_file *f, struct keydesc *kd, cob_file_key *key) { - int keylen,part; + int keylen, part; memset (kd,0,sizeof (struct keydesc)); kd->k_flags = key->tf_duplicates ? ISDUPS : ISNODUPS; if (key->count_components < 1) { @@ -301,14 +302,15 @@ indexed_keydesc (cob_file *f, struct keydesc *kd, cob_file_key *key) /* LCOV_EXCL_STOP */ keylen = 0; for (part=0; part < key->count_components; part++) { - kd->k_part[part].kp_start = key->component[part]->data - f->record->data; - kd->k_part[part].kp_leng = key->component[part]->size; - keylen += kd->k_part[part].kp_leng; - kd->k_part[part].kp_type = CHARTYPE; + struct keypart *k_part = &kd->k_part[part]; + k_part->kp_start = key->component[part]->data - f->record->data; + k_part->kp_leng = key->component[part]->size; + keylen += k_part->kp_leng; + k_part->kp_type = CHARTYPE; if (key->tf_suppress) { #ifdef NULLKEY kd->k_flags |= NULLKEY; - kd->k_part[part].kp_type = CHARTYPE | (key->char_suppress << 8); + k_part->kp_type = CHARTYPE | (key->char_suppress << 8); #else #if 0 /* TODO: SUPPRESS string not merged yet */ f->flag_write_chk_dups = 1; @@ -331,20 +333,16 @@ static int indexed_keycmp (struct keydesc *k1, struct keydesc *k2) { int part; - if (k1->k_flags != k2->k_flags) { + if (k1->k_flags != k2->k_flags + || k1->k_nparts != k2->k_nparts) { return 1; } - if (k1->k_nparts != k2->k_nparts) { - return 1; - } - for (part=0; part < k1->k_nparts; part++) { - if (k1->k_part[part].kp_start != k2->k_part[part].kp_start) { - return 1; - } - if (k1->k_part[part].kp_leng != k2->k_part[part].kp_leng) { - return 1; - } - if (k1->k_part[part].kp_type != k2->k_part[part].kp_type) { + for (part = 0; part < k1->k_nparts; part++) { + const struct keypart *k_part1 = &k1->k_part[part]; + const struct keypart *k_part2 = &k2->k_part[part]; + if (k_part1->kp_start != k_part2->kp_start + || k_part1->kp_leng != k_part2->kp_leng + || k_part1->kp_type != k_part2->kp_type) { return 1; } } @@ -377,7 +375,7 @@ cob_findkey_attr (cob_file *f, cob_field *kf, int *fullkeylen, int *partlen) && key->data == kf->data && key->size == kf->size) || (f->keys[k].component[0]->data == kf->data)) { - for (part=0; part < f->keys[k].count_components; part++) { + for (part = 0; part < f->keys[k].count_components; part++) { *fullkeylen += f->keys[k].component[part]->size; } if (key @@ -1111,7 +1109,7 @@ cob_chk_file_mapping (void) /* Simple case - No separators [note: this is also the ACU and Fujitsu way] */ if (!looks_absolute (src) && !has_directory_separator (src)) { - + /* Drop surrounding quotes, some implementations need those to support filename with embedded spaces (like MF), while others (like GC before 3.2) don't like them */ @@ -2505,7 +2503,7 @@ lineseq_read (cob_file *f, const int read_opts) dataptr = f->record->data; again: fp = (FILE *)f->file; - /* save last position at start of line; needed for REWRITE (I-O only) */ + /* save last position at start of line; needed for REWRITE (I-O only) */ if (f->open_mode == COB_OPEN_I_O) { f->record_off = ftell (fp); /* Note: at least on Win32 the offset resolved does only return the right values @@ -2727,7 +2725,7 @@ lineseq_write (cob_file *f, const int opt) f->flag_needs_nl = 1; } - /* save last position at start of line; needed for REWRITE (I-O only) */ + /* save last position at start of line; needed for REWRITE (I-O only) */ if (f->open_mode == COB_OPEN_I_O) { f->record_off = ftell (fp); /* Note: at least on Win32 the offset resolved does only return the right values @@ -3407,12 +3405,11 @@ freefh (struct indexfile *fh) static void restorefileposition (cob_file *f) { - struct indexfile *fh; - struct keydesc k0; + struct indexfile *fh = f->file; - fh = f->file; - memset ((void *)&k0, 0, sizeof (k0)); if (fh->saverecnum >= 0) { + struct keydesc *key = &fh->key[f->curkey]; + struct keydesc k0 = { 0 }; /* Switch back to index */ ISRECNUM = fh->saverecnum; /* Switch to recnum mode */ @@ -3420,8 +3417,7 @@ restorefileposition (cob_file *f) /* Read by record number */ isread (fh->isfd, (void *)fh->recwrk, ISEQUAL); /* Read by current key value */ - isstart (fh->isfd, &fh->key[f->curkey], 0, - (void *)fh->recwrk, ISGTEQ); + isstart (fh->isfd, key, 0, (void *)fh->recwrk, ISGTEQ); isread (fh->isfd, (void *)fh->recwrk, ISGTEQ); while (ISRECNUM != fh->saverecnum) { /* Read back into position */ @@ -3438,9 +3434,9 @@ restorefileposition (cob_file *f) } } } else if (fh->readdone && f->curkey == 0) { + struct keydesc *key = &fh->key[0]; indexed_restorekey(fh, NULL, 0); - isstart (fh->isfd, &fh->key[f->curkey], 0, - (void *)fh->recwrk, ISGTEQ); + isstart (fh->isfd, key, 0, (void *)fh->recwrk, ISGTEQ); } } @@ -3726,13 +3722,8 @@ static int indexed_write_internal (cob_file *f, const int rewrite, const int opt) { struct indexed_file *p = f->file; - cob_u32_t i, len; - unsigned int dupno; - cob_u32_t flags = 0; - int close_cursor, ret; - - close_cursor = bdb_open_cursor (f, 1); - ret = COB_STATUS_00_SUCCESS; + const int close_cursor = bdb_open_cursor (f, 1); + cob_u32_t i; /* Check duplicate alternate keys */ if (f->nkeys > 1 && !rewrite) { @@ -3761,6 +3752,8 @@ indexed_write_internal (cob_file *f, const int rewrite, const int opt) /* Write secondary keys */ p->data = p->key; for (i = 1; i < f->nkeys; ++i) { + cob_u32_t flags, len; + int ret; if (rewrite && ! p->rewrite_sec_key[i]) { continue; } @@ -3770,8 +3763,8 @@ indexed_write_internal (cob_file *f, const int rewrite, const int opt) bdb_setkey (f, i); memset ((void*)&p->data, 0, sizeof (DBT)); if (f->keys[i].tf_duplicates) { + unsigned int dupno = get_dupno (f, i); flags = 0; - dupno = get_dupno (f, i); if (dupno > 1) { ret = COB_STATUS_02_SUCCESS_DUPLICATE; } @@ -3786,7 +3779,6 @@ indexed_write_internal (cob_file *f, const int rewrite, const int opt) p->data.data = p->temp_key; p->data.size = (cob_dbtsize_t)len; flags = DB_NOOVERWRITE; - dupno = 0; } bdb_setkey (f, i); @@ -3819,7 +3811,7 @@ indexed_write_internal (cob_file *f, const int rewrite, const int opt) return COB_STATUS_51_RECORD_LOCKED; } } - return ret; + return COB_STATUS_00_SUCCESS; } static int @@ -4199,15 +4191,13 @@ indexed_open (cob_file *f, char *filename, struct indexfile *fh; size_t k; - int ret,len; + int ret, len; int omode; int lmode; int vmode; int dobld; int isfd; int checkvalue; - struct keydesc kd; - struct dictinfo di; /* Defined in (c|d|vb)isam.h */ COB_UNUSED (sharing); @@ -4311,17 +4301,17 @@ indexed_open (cob_file *f, char *filename, } fh = cob_malloc (sizeof (struct indexfile) + ((sizeof (struct keydesc)) * (f->nkeys + 1))); - /* Copy index information */ - for (k = 0; k < f->nkeys; ++k) { - len = indexed_keydesc(f, &fh->key[k], &f->keys[k]); - if (fh->lenkey < len) { - fh->lenkey = len; - } - } ISERRNO = 0; fh->lmode = 0; if (dobld) { dobuild: + /* copy index information cob_file_key -> keydesc */ + for (k = 0; k < f->nkeys; ++k) { + len = indexed_keydesc (f, &fh->key[k], &f->keys[k]); + if (fh->lenkey < len) { + fh->lenkey = len; + } + } isfd = isbuild ((void *)filename, (int)f->record_max, &fh->key[0], vmode | ISINOUT | ISEXCLLOCK); #if 0 /* activate on later merge of locking enhancements */ @@ -4346,9 +4336,41 @@ indexed_open (cob_file *f, char *filename, lmode = ISMANULOCK; } isfd = isopen ((void *)filename, omode | lmode | vmode); - if (isfd < 0) { - if (ISERRNO == EFLOCKED) + if (isfd >= 0) { + struct dictinfo di = { 0 }; /* Defined in (c|d|vb)isam.h */ + isindexinfo (isfd, (void *)&di, 0); + /* Mask off ISVARLEN */ + fh->nkeys = di.di_nkeys & 0x7F; + if (fh->nkeys != f->nkeys + || f->record_max != di.di_recsize) { + ret = COB_STATUS_39_CONFLICT_ATTRIBUTE; + } + for (k = 0; k < fh->nkeys && !ret; ++k) { + struct keydesc kd = { 0 }; + /* get key info from ISAM */ + struct keydesc key = { 0 }; /* init to prevent analyzer warning */ + int len_key; + isindexinfo (isfd, &key, (int)(k + 1)); + len = indexed_keylen (&key); + if (fh->lenkey < len) { + fh->lenkey = len; + } + /* get key info from cob_key */ + len_key = indexed_keydesc (f, &kd, &f->keys[k]); + /* verify that COBOL keys match exactly to real ISAM keys */ + if (len_key != len + || indexed_keycmp (&kd, &key) != 0) { + ret = COB_STATUS_39_CONFLICT_ATTRIBUTE; + break; + } + /* store ISAM key definition */ + memcpy (&fh->key[k], &key, sizeof (struct keydesc)); + } + } else { /* opening the file is not possible */ + if (ISERRNO == EFLOCKED) { + freefh (fh); return COB_STATUS_61_FILE_SHARING; + } if (f->flag_optional) { if (mode == COB_OPEN_EXTEND || mode == COB_OPEN_I_O) { @@ -4366,33 +4388,6 @@ indexed_open (cob_file *f, char *filename, f->flag_nonexistent = 1; return COB_STATUS_05_SUCCESS_OPTIONAL; } - } else { - memset(&di, 0, sizeof (di)); - isindexinfo (isfd, (void *)&di, 0); - /* Mask off ISVARLEN */ - fh->nkeys = di.di_nkeys & 0x7F; - if (fh->nkeys != f->nkeys) { - ret = COB_STATUS_39_CONFLICT_ATTRIBUTE; - } - if (f->record_max != di.di_recsize) { - ret = COB_STATUS_39_CONFLICT_ATTRIBUTE; - } - for (k = 0; k < fh->nkeys && !ret; ++k) { - memset (&fh->key[k], 0, sizeof (struct keydesc)); - isindexinfo (isfd, &fh->key[k], (int)(k+1)); - if (fh->lenkey < indexed_keylen(fh, k)) { - fh->lenkey = indexed_keylen(fh, k); - } - /* Verify that COBOL keys match exactly to real ISAM keys */ - len = indexed_keydesc(f, &kd, &f->keys[k]); - if (fh->lenkey < len) { - fh->lenkey = len; - } - if(indexed_keycmp(&kd, &fh->key[k]) != 0) { - ret = COB_STATUS_39_CONFLICT_ATTRIBUTE; - break; - } - } } } if (isfd < 0) { @@ -4831,13 +4826,13 @@ indexed_start (cob_file *f, const int cond, cob_field *key) #elif defined(WITH_ANY_ISAM) - struct indexfile *fh; + struct indexfile *fh = f->file; int k; int mode; int klen,fullkeylen,partlen; int savecond; + struct keydesc *keyd; - fh = f->file; f->flag_read_done = 0; f->flag_first_read = 0; fh->readdone = 0; @@ -4852,6 +4847,7 @@ indexed_start (cob_file *f, const int cond, cob_field *key) return COB_STATUS_23_KEY_NOT_EXISTS; } f->mapkey = k; + keyd = &fh->key[k]; /* Use size of data field; This may indicate a partial key */ klen = partlen; if (klen < 1 || klen > fullkeylen) { @@ -4893,9 +4889,9 @@ indexed_start (cob_file *f, const int cond, cob_field *key) default: return COB_STATUS_21_KEY_INVALID; } - if (isstart (fh->isfd, &fh->key[k], klen, (void *)f->record->data, mode)) { + if (isstart (fh->isfd, keyd, klen, (void *)f->record->data, mode)) { if (cond == COB_LE || cond == COB_LT) { - if (isstart (fh->isfd, &fh->key[k], klen, (void *)f->record->data, ISLAST)) { + if (isstart (fh->isfd, keyd, klen, (void *)f->record->data, ISLAST)) { f->curkey = -1; f->mapkey = -1; fh->startcond = -1; @@ -4915,7 +4911,7 @@ indexed_start (cob_file *f, const int cond, cob_field *key) } } fh->startcond = savecond; - indexed_savekey(fh, f->record->data, k); + indexed_savekey (fh, f->record->data, k); f->curkey = k; f->flag_end_of_file = 0; f->flag_begin_of_file = 0; @@ -5008,7 +5004,7 @@ indexed_read (cob_file *f, cob_field *key, const int read_opts) fh->readdone = 1; f->flag_end_of_file = 0; f->flag_begin_of_file = 0; - indexed_savekey(fh, f->record->data, 0); + indexed_savekey (fh, f->record->data, 0); fh->recnum = ISRECNUM; #ifdef ISVARLEN if (f->record_min != f->record_max) { @@ -5140,7 +5136,7 @@ indexed_read_next (cob_file *f, const int read_opts) case COB_GE: domoveback = 0; while (ISERRNO == 0 - && indexed_cmpkey(fh, f->record->data, f->curkey, 0) == 0) { + && indexed_cmpkey (fh, f->record->data, f->curkey, 0) == 0) { isread (fh->isfd, (void *)f->record->data, ISPREV); domoveback = 1; } @@ -5151,7 +5147,7 @@ indexed_read_next (cob_file *f, const int read_opts) case COB_LE: domoveback = 0; while (ISERRNO == 0 - && indexed_cmpkey(fh, f->record->data, f->curkey, 0) == 0) { + && indexed_cmpkey (fh, f->record->data, f->curkey, 0) == 0) { isread (fh->isfd, (void *)f->record->data, ISNEXT); domoveback = 1; } @@ -5160,15 +5156,17 @@ indexed_read_next (cob_file *f, const int read_opts) } break; case COB_LT: +#if 0 /* CHECKME, not in GC4 */ isread (fh->isfd, (void *)f->record->data, ISPREV); +#endif while (ISERRNO == 0 - && indexed_cmpkey(fh, f->record->data, f->curkey, 0) >= 0) { + && indexed_cmpkey (fh, f->record->data, f->curkey, 0) >= 0) { isread (fh->isfd, (void *)f->record->data, ISPREV); } break; case COB_GT: while (ISERRNO == 0 - && indexed_cmpkey(fh, f->record->data, f->curkey, 0) <= 0) { + && indexed_cmpkey (fh, f->record->data, f->curkey, 0) <= 0) { isread (fh->isfd, (void *)f->record->data, ISNEXT); } break; @@ -5218,12 +5216,12 @@ indexed_read_next (cob_file *f, const int read_opts) } else { switch (fh->startcond) { case COB_LE: - if(indexed_cmpkey(fh, f->record->data, f->curkey, 0) > 0) + if (indexed_cmpkey (fh, f->record->data, f->curkey, 0) > 0) domoveback = 1; else domoveback = 0; while (ISERRNO == 0 - && indexed_cmpkey(fh, f->record->data, f->curkey, 0) == 0) { + && indexed_cmpkey (fh, f->record->data, f->curkey, 0) == 0) { isread (fh->isfd, (void *)f->record->data, ISNEXT); domoveback = 1; } @@ -5233,19 +5231,19 @@ indexed_read_next (cob_file *f, const int read_opts) break; case COB_LT: while (ISERRNO == 0 - && indexed_cmpkey(fh, f->record->data, f->curkey, 0) >= 0) { + && indexed_cmpkey (fh, f->record->data, f->curkey, 0) >= 0) { isread (fh->isfd, (void *)f->record->data, ISPREV); } break; case COB_GT: while (ISERRNO == 0 - && indexed_cmpkey(fh, f->record->data, f->curkey, 0) <= 0) { + && indexed_cmpkey (fh, f->record->data, f->curkey, 0) <= 0) { isread (fh->isfd, (void *)f->record->data, ISNEXT); } break; case COB_GE: while (ISERRNO == 0 - && indexed_cmpkey(fh, f->record->data, f->curkey, 0) < 0) { + && indexed_cmpkey (fh, f->record->data, f->curkey, 0) < 0) { isread (fh->isfd, (void *)f->record->data, ISNEXT); } break; @@ -5307,7 +5305,7 @@ indexed_read_next (cob_file *f, const int read_opts) fh->readdone = 1; f->flag_end_of_file = 0; f->flag_begin_of_file = 0; - indexed_savekey(fh, f->record->data, 0); + indexed_savekey (fh, f->record->data, 0); fh->recnum = ISRECNUM; #ifdef ISVARLEN if (f->record_min != f->record_max) { @@ -5316,11 +5314,12 @@ indexed_read_next (cob_file *f, const int read_opts) #endif #ifdef COB_WITH_STATUS_02 - if((isstat1 == '0') && (isstat2 == '2')) { + if (isstat1 == '0' + && isstat2 == '2') { return COB_STATUS_02_SUCCESS_DUPLICATE; } #endif - return 0; + return COB_STATUS_00_SUCCESS; #elif defined(WITH_DB) @@ -5427,7 +5426,7 @@ indexed_read_next (cob_file *f, const int read_opts) if (nextprev == DB_FIRST || nextprev == DB_LAST) { read_nextprev = 1; } else { - p->key.size = (cob_dbtsize_t) bdb_keylen(f,p->key_index); + p->key.size = (cob_dbtsize_t) bdb_keylen (f, p->key_index); p->key.data = p->last_readkey[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 */ @@ -5510,7 +5509,7 @@ indexed_read_next (cob_file *f, const int read_opts) } p->key.data = p->data.data; p->key.size = p->primekeylen; - ret = DB_GET (p->db[0], &p->key, &p->data, 0); + ret = DB_GET (p->db[0], &p->key, &p->data, 0); if (ret != 0) { bdb_close_index (f, p->key_index); bdb_close_cursor (f); @@ -5535,7 +5534,7 @@ indexed_read_next (cob_file *f, const int read_opts) memcpy (p->last_readkey[0], p->key.data, (size_t)p->key.size); } else { memcpy (p->last_readkey[p->key_index], p->temp_key, - bdb_keylen(f,p->key_index)); + bdb_keylen(f,p->key_index)); memcpy (p->last_readkey[p->key_index + f->nkeys], p->key.data, p->primekeylen); if (f->keys[p->key_index].tf_duplicates) { p->last_dupno[p->key_index] = dupno; @@ -5579,16 +5578,15 @@ indexed_write (cob_file *f, const int opt) #elif defined(WITH_ANY_ISAM) - struct indexfile *fh; + struct indexfile *fh = f->file; COB_UNUSED (opt); - fh = f->file; if (f->flag_nonexistent) { return COB_STATUS_48_OUTPUT_DENIED; } if (f->access_mode == COB_ACCESS_SEQUENTIAL - && indexed_cmpkey(fh, f->record->data, 0, 0) <= 0) { + && indexed_cmpkey (fh, f->record->data, 0, 0) <= 0) { return COB_STATUS_21_KEY_INVALID; } @@ -5608,14 +5606,15 @@ indexed_write (cob_file *f, const int opt) } return fisretsts (COB_STATUS_49_I_O_DENIED); } - indexed_savekey(fh, f->record->data, 0); + indexed_savekey (fh, f->record->data, 0); #ifdef COB_WITH_STATUS_02 - if((isstat1 == '0') && (isstat2 == '2')) { + if (isstat1 == '0' + && isstat2 == '2') { return COB_STATUS_02_SUCCESS_DUPLICATE; } #endif - return 0; + return COB_STATUS_00_SUCCESS; #elif defined(WITH_DB) @@ -5731,7 +5730,8 @@ indexed_rewrite (cob_file *f, const int opt) struct indexfile *fh; size_t k; - int ret, retdup; + int ret; + int retdup = 0; COB_UNUSED (opt); @@ -5742,21 +5742,21 @@ indexed_rewrite (cob_file *f, const int opt) } if (f->access_mode == COB_ACCESS_SEQUENTIAL - && indexed_cmpkey(fh, f->record->data, 0, 0) != 0) { + && indexed_cmpkey (fh, f->record->data, 0, 0) != 0) { return COB_STATUS_21_KEY_INVALID; } if (f->curkey >= 0) { /* Index is active */ /* Save record data */ memcpy (fh->recwrk, f->record->data, f->record_max); -/* RXWRXW - readdir */ + /* RXWRXW - readdir */ fh->readdir = ISNEXT; savefileposition (f); memcpy (fh->recwrk, f->record->data, f->record_max); if (f->curkey != 0) { /* Activate primary index */ - isstart (fh->isfd, &fh->key[0], 0, (void *)fh->recwrk, - ISEQUAL); + isstart (fh->isfd, &fh->key[0], fh->key[0].k_len, + (void *)fh->recwrk, ISEQUAL); } /* Verify record exists */ if (isread (fh->isfd, (void *)fh->recwrk, ISEQUAL)) { @@ -5764,12 +5764,13 @@ indexed_rewrite (cob_file *f, const int opt) return COB_STATUS_21_KEY_INVALID; } for (k = 1; k < f->nkeys && ret == COB_STATUS_00_SUCCESS; ++k) { - if (fh->key[k].k_flags & ISDUPS) { + struct keydesc *key = &fh->key[k]; + if (key->k_flags & ISDUPS) { continue; } memcpy (fh->recwrk, f->record->data, f->record_max); - isstart (fh->isfd, &fh->key[k], fh->key[k].k_leng, - (void *)fh->recwrk, ISEQUAL); + isstart (fh->isfd, key, key->k_leng, + (void *)fh->recwrk, ISEQUAL); if (!isread (fh->isfd, (void *)fh->recwrk, ISEQUAL) && ISRECNUM != fh->recnum) { ret = COB_STATUS_22_KEY_EXISTS; @@ -5778,8 +5779,8 @@ indexed_rewrite (cob_file *f, const int opt) } if (ret == COB_STATUS_00_SUCCESS) { memcpy (fh->recwrk, f->record->data, f->record_max); - isstart (fh->isfd, &fh->key[0], 0, (void *)fh->recwrk, - ISEQUAL); + isstart (fh->isfd, &fh->key[0], fh->key[0].k_len, + (void *)fh->recwrk, ISEQUAL); if (isread (fh->isfd, (void *)fh->recwrk, ISEQUAL | ISLOCK)) { ret = fisretsts (COB_STATUS_49_I_O_DENIED); } else { @@ -5792,16 +5793,16 @@ indexed_rewrite (cob_file *f, const int opt) ret = fisretsts (COB_STATUS_49_I_O_DENIED); } } - } - #ifdef COB_WITH_STATUS_02 - if (!ret && (isstat1 == '0') && (isstat2 == '2')) { - retdup = COB_STATUS_02_SUCCESS_DUPLICATE; - } + if (!ret && (isstat1 == '0') && (isstat2 == '2')) { + retdup = COB_STATUS_02_SUCCESS_DUPLICATE; + } #endif + } + restorefileposition (f); - } else { + } else { /* Index is not active */ memcpy (fh->recwrk, f->record->data, f->record_max); if (isread (fh->isfd, (void *)fh->recwrk, ISEQUAL | ISLOCK)) { @@ -5815,34 +5816,30 @@ indexed_rewrite (cob_file *f, const int opt) if (isrewrite (fh->isfd, (void *)f->record->data)) { ret = fisretsts (COB_STATUS_49_I_O_DENIED); } + } #ifdef COB_WITH_STATUS_02 - if (!ret && (isstat1 == '0') && (isstat2 == '2')) { - retdup = COB_STATUS_02_SUCCESS_DUPLICATE; - } -#endif + if (!ret && (isstat1 == '0') && (isstat2 == '2')) { + retdup = COB_STATUS_02_SUCCESS_DUPLICATE; } +#endif if (!ret) { if ((f->lock_mode & COB_LOCK_AUTOMATIC) && !(f->lock_mode & COB_LOCK_MULTIPLE)) { isrelease (fh->isfd); } -#ifdef COB_WITH_STATUS_02 - if ((isstat1 == '0') && (isstat2 == '2')) { - retdup = COB_STATUS_02_SUCCESS_DUPLICATE; - } -#endif } } + if (retdup) { /* FIXME: use (is_suppressed_key_value) or similar to verify - that the duplicate this is not a SUPPRESSed KEY */ - return retdup; + that the duplicate is not a SUPPRESSed KEY */ + return COB_STATUS_02_SUCCESS_DUPLICATE; } return ret; #elif defined(WITH_DB) - int ret; + int ret; if (f->flag_nonexistent) { return COB_STATUS_49_I_O_DENIED; @@ -5865,8 +5862,9 @@ indexed_rewrite (cob_file *f, const int opt) if (ret != COB_STATUS_00_SUCCESS) { bdb_close_cursor (f); - if (ret == COB_STATUS_23_KEY_NOT_EXISTS) + if (ret == COB_STATUS_23_KEY_NOT_EXISTS) { return COB_STATUS_21_KEY_INVALID; + } return ret; } @@ -8863,7 +8861,7 @@ update_file_to_fcd (cob_file *f, FCD3 *fcd, unsigned char *fnstatus) memcpy (fcd->fileStatus, f->file_status, 2); /* FIXME: use switch here */ if (f->open_mode == COB_OPEN_CLOSED - || f->open_mode == COB_OPEN_LOCKED) + || f->open_mode == COB_OPEN_LOCKED) fcd->openMode = OPEN_NOT_OPEN; else if( f->open_mode == COB_OPEN_INPUT) fcd->openMode = OPEN_INPUT; @@ -10175,7 +10173,7 @@ update_key_from_fcd (cob_file *f, FCD3 *fcd, cob_field *kf) && keylen < kf->size) { kf->size = keylen; } - } else + } else if (fcd->fileOrg == ORG_RELATIVE) { cob_field *rel_key = f->keys[0].field; /* set value in the key field (several functions don't pass this outside of "f") */ diff --git a/tests/testsuite.src/run_file.at b/tests/testsuite.src/run_file.at index 2ce70bc84..2126dec17 100644 --- a/tests/testsuite.src/run_file.at +++ b/tests/testsuite.src/run_file.at @@ -1,4 +1,4 @@ -## Copyright (C) 2003-2012, 2014-2023 Free Software Foundation, Inc. +## Copyright (C) 2003-2012, 2014-2024 Free Software Foundation, Inc. ## Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman, ## Brian Tiffin, Joe Robbins, Edward Hart ## @@ -256,12 +256,12 @@ AT_DATA([prog.cob], [ DATA DIVISION. FILE SECTION. FD TEST-XML00 RECORD VARYING FROM 5 TO 500 CHARACTERS. - 01 E-ENR PIC X(500). + 01 E-ENR PIC X(500). WORKING-STORAGE SECTION. - 01 ST-TEST PIC X(2). - 01 W-TYPE PIC 9(03) VALUE ZERO. + 01 ST-TEST PIC X(2). + 01 W-TYPE PIC 9(03) VALUE ZERO. 01 EOF-TEST-XML PIC 9(03) VALUE ZERO. - 01 COUNT-PASS PIC 9(02) VALUE ZERO. + 01 COUNT-PASS PIC 9(02) VALUE ZERO. PROCEDURE DIVISION. DEBUT. OPEN INPUT TEST-XML00 @@ -1947,8 +1947,9 @@ AT_DATA([prog.cob], [ MOVE ALL "*" TO CM-TAPE. WRITE TSPFL-RECORD. - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" + * Note: some ISAM implementations do not support status 02 + IF CUST-STAT NOT = "02" + AND CUST-STAT NOT = "00" DISPLAY "Key: " TSPFL-KEY ", Status: " CUST-STAT UPON CONSOLE. @@ -7156,9 +7157,9 @@ AT_DATA([prog.cob], [ MOVE "~~~" TO f-key1-2 START f KEY = f-key1-1 READ f NEXT - IF (f-status <> "00") OR - (file1-serial <> 4) - DISPLAY "FAILED 1: status " f-status "-" + IF (f-status <> "00") + OR (file1-serial <> 4) + DISPLAY "FAILED 1: status " f-status " - " "serial: " file1-serial END-IF @@ -7166,9 +7167,9 @@ AT_DATA([prog.cob], [ MOVE "~~~" TO f-key1-2 START f KEY < f-key1-1 READ f PREVIOUS - IF (f-status <> "00") OR - (file1-serial <> 3) - DISPLAY "FAILED 2: status " f-status "-" + IF (f-status <> "00") + OR (file1-serial <> 3) + DISPLAY "FAILED 2: status " f-status " - " "serial: " file1-serial END-IF @@ -7176,9 +7177,9 @@ AT_DATA([prog.cob], [ MOVE "~~~" TO f-key1-2 START f KEY > f-key1-1 READ f NEXT - IF (f-status <> "00") OR - (file1-serial <> 4) - DISPLAY "FAILED 3: status " f-status "-" + IF (f-status <> "00") + OR (file1-serial <> 4) + DISPLAY "FAILED 3: status " f-status " - " "serial: " file1-serial END-IF @@ -7186,9 +7187,9 @@ AT_DATA([prog.cob], [ MOVE "~~~" TO f-key2-2 START f KEY = f-key2-1 READ f NEXT - IF (f-status <> "00") OR - (file1-serial <> 4) - DISPLAY "FAILED 4: status " f-status "-" + IF (f-status <> "00") + OR (file1-serial <> 4) + DISPLAY "FAILED 4: status " f-status " - " "serial: " file1-serial END-IF @@ -7196,9 +7197,9 @@ AT_DATA([prog.cob], [ MOVE "~~~" TO f-key2-2 START f KEY < f-key2-1 READ f PREVIOUS - IF (f-status <> "00") OR - (file1-serial <> 3) - DISPLAY "FAILED 5: status " f-status "-" + IF (f-status <> "00") + OR (file1-serial <> 3) + DISPLAY "FAILED 5: status " f-status " - " "serial: " file1-serial END-IF @@ -7206,9 +7207,9 @@ AT_DATA([prog.cob], [ MOVE "~~~" TO f-key2-2 START f KEY > f-key2-1 READ f NEXT - IF (f-status <> "00") OR - (file1-serial <> 4) - DISPLAY "FAILED 6: status " f-status "-" + IF (f-status <> "00") + OR (file1-serial <> 4) + DISPLAY "FAILED 6: status " f-status " - " "serial: " file1-serial END-IF @@ -7216,12 +7217,12 @@ AT_DATA([prog.cob], [ START f KEY > f-key3-1 READ f NEXT * CHECK: Return file-status "02" if duplicates exist - IF (f-status <> "02" - * Depends on xISAM implementation and the way BDB is used (not yet - * implemented in 3.x) - AND f-status <> "00" - ) OR file1-serial <> 3 - DISPLAY "FAILED 7: status " f-status "-" + * Depends on xISAM implementation and also on the way BDB is used + IF (f-status <> "02" + AND f-status <> "00") + OR (file1-serial <> 3) + DISPLAY "FAILED 7: status " f-status " - " + "serial: " file1-serial END-IF CLOSE f STOP RUN