From 50cd59618bdd52651a8ade7db4c46e2b7eae9dbd Mon Sep 17 00:00:00 2001 From: David Declerck Date: Mon, 2 Sep 2024 18:10:45 +0200 Subject: [PATCH] Merged SVN 4920 --- NEWS | 6 ++- autogen.sh | 2 +- libcob/ChangeLog | 4 ++ libcob/intrinsic.c | 128 +++++++++++++++------------------------------ 4 files changed, 52 insertions(+), 88 deletions(-) diff --git a/NEWS b/NEWS index 6104c55e9..b662c16f3 100644 --- a/NEWS +++ b/NEWS @@ -349,6 +349,9 @@ Open Plans: ** new compiler command line option -ftcmd to enable printing of the command line in the source listing +** new compiler command line option --coverage to instrument binaries + for coverage checks + ** the command line options -MT and -MF, which are used for creating a dependency list (used copybooks) to be used for inclusion in Makefiles or other processes, and which were removed in GnuCOBOL 2 are back in their @@ -442,7 +445,8 @@ Open Plans: MOVE and comparisions (especially with enabled runtime checks, to optimize those a re-compile is needed) CALL data-item, and first time for each CALL - ACCEPT DATE/TIME/DAY and datetime related FUNCTIONs + ACCEPT DATE/TIME/DAY, most if numeric items are accepted + datetime related FUNCTIONs runtime checks for use of LINKAGE/BASED fields and/or subscripts/reference-modification (re-compile needed) general: execution of programs generated with -fsource-location diff --git a/autogen.sh b/autogen.sh index cd4eb8381..085ac600c 100755 --- a/autogen.sh +++ b/autogen.sh @@ -3,7 +3,7 @@ # Bootstrap gnucobol package from checked-out sources # Note: call as ./autogen.sh if you don't have readlink -f # -# Copyright (C) 2019, 2022 Free Software Foundation, Inc. +# Copyright (C) 2019,2022,2023 Free Software Foundation, Inc. # Written by Simon Sobisch # # This file is part of GnuCOBOL. diff --git a/libcob/ChangeLog b/libcob/ChangeLog index 84b83c51e..3c7dd33e5 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -93,6 +93,10 @@ * screenio.c: renamed max_pairs_available as this is defined on HPUX * common.c (check_current_date): fixed bad snprintf size +2023-01-12 Simon Sobisch + + * intrinsic.c: minor refactoring to reduce duplicated code + 2023-01-04 Simon Sobisch * common.c (cob_cmp): fix stack-use-after-scope for comparisons of unsigned diff --git a/libcob/intrinsic.c b/libcob/intrinsic.c index 071c98a89..8908389be 100644 --- a/libcob/intrinsic.c +++ b/libcob/intrinsic.c @@ -1,5 +1,5 @@ /* - Copyright (C) 2005-2012, 2014-2022 Free Software Foundation, Inc. + Copyright (C) 2005-2012, 2014-2023 Free Software Foundation, Inc. Written by Roger While, Simon Sobisch, Edward Hart, Brian Tiffin This file is part of GnuCOBOL. @@ -1887,7 +1887,7 @@ locale_time (const int hours, const int minutes, const int seconds, /* offset and length are for reference modification */ static void -cob_alloc_set_field_str (char *str, const int offset, const int length) +cob_alloc_set_field_str (const char *str, const int offset, const int length) { const size_t str_len = strlen (str); cob_field field; @@ -3854,15 +3854,13 @@ cob_intr_reverse (const int offset, const int length, cob_field *srcfield) cob_field * cob_intr_bit_of (cob_field *srcfield) { - cob_field_attr attr; cob_field field; /* FIXME later: srcfield may be of category national - or later bit... */ const size_t size = srcfield->size * 8; unsigned char *byte = srcfield->data; size_t i, j; - COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL); - COB_FIELD_INIT (size, NULL, &attr); + COB_FIELD_INIT (size, NULL, &const_alpha_attr); make_field_entry (&field); for (i = j = 0; i < srcfield->size; ++i) { @@ -3891,14 +3889,12 @@ has_bit_checked (const unsigned char byte) { cob_field * cob_intr_bit_to_char (cob_field *srcfield) { - cob_field_attr attr; cob_field field; const size_t size = srcfield->size / 8; unsigned char *byte_val, *char_val; size_t i; - COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL); - COB_FIELD_INIT (size, NULL, &attr); + COB_FIELD_INIT (size, NULL, &const_alpha_attr); make_field_entry (&field); byte_val = srcfield->data; @@ -3921,14 +3917,12 @@ cob_intr_bit_to_char (cob_field *srcfield) cob_field * cob_intr_hex_of (cob_field *srcfield) { - cob_field_attr attr; cob_field field; /* FIXME later: srcfield may be of category national - or later bit... */ const size_t size = srcfield->size * 2; size_t i, j; - COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL); - COB_FIELD_INIT (size, NULL, &attr); + COB_FIELD_INIT (size, NULL, &const_alpha_attr); make_field_entry (&field); for (i = j = 0; i < srcfield->size; ++i) { @@ -3943,19 +3937,17 @@ cob_intr_hex_of (cob_field *srcfield) cob_field * cob_intr_hex_to_char (cob_field *srcfield) { - cob_field_attr attr; cob_field field; const size_t size = srcfield->size / 2; size_t i, j; unsigned char *hex_char; if (size * 2 != srcfield->size) { - /* posibly raise nonfatal exception here -> we only process the valid ones */ + /* possibly raise nonfatal exception here -> we only process the valid ones */ /* size--; */ } - COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL); - COB_FIELD_INIT (size, NULL, &attr); + COB_FIELD_INIT (size, NULL, &const_alpha_attr); make_field_entry (&field); hex_char = curr_field->data; @@ -4022,83 +4014,52 @@ cob_intr_module_time (void) cob_field * cob_intr_module_id (void) { - size_t calcsize; - cob_field field; - - calcsize = strlen (COB_MODULE_PTR->module_name); - COB_FIELD_INIT (calcsize, NULL, &const_alpha_attr); - make_field_entry (&field); - memcpy (curr_field->data, COB_MODULE_PTR->module_name, calcsize); + cob_alloc_set_field_str (COB_MODULE_PTR->module_name, 0, 0); return curr_field; } cob_field * cob_intr_module_caller_id (void) { - size_t calcsize; - cob_field field; - if (!COB_MODULE_PTR->next) { + cob_field field; COB_FIELD_INIT (1, NULL, &const_alpha_attr); make_field_entry (&field); curr_field->size = 0; curr_field->data[0] = ' '; return curr_field; } - calcsize = strlen (COB_MODULE_PTR->next->module_name); - COB_FIELD_INIT (calcsize, NULL, &const_alpha_attr); - make_field_entry (&field); - memcpy (curr_field->data, COB_MODULE_PTR->next->module_name, - calcsize); + cob_alloc_set_field_str (COB_MODULE_PTR->next->module_name, 0, 0); return curr_field; } cob_field * cob_intr_module_formatted_date (void) { - size_t calcsize; - cob_field field; - - calcsize = strlen (COB_MODULE_PTR->module_formatted_date); - COB_FIELD_INIT (calcsize, NULL, &const_alpha_attr); - make_field_entry (&field); - memcpy (curr_field->data, COB_MODULE_PTR->module_formatted_date, - calcsize); + cob_alloc_set_field_str (COB_MODULE_PTR->module_formatted_date, 0, 0); return curr_field; } cob_field * cob_intr_module_source (void) { - size_t calcsize; - cob_field field; - - calcsize = strlen (COB_MODULE_PTR->module_source); - COB_FIELD_INIT (calcsize, NULL, &const_alpha_attr); - make_field_entry (&field); - memcpy (curr_field->data, COB_MODULE_PTR->module_source, calcsize); + cob_alloc_set_field_str (COB_MODULE_PTR->module_source, 0, 0); return curr_field; } cob_field * cob_intr_module_path (void) { - size_t calcsize; - cob_field field; - - if (!COB_MODULE_PTR->module_path || - !*(COB_MODULE_PTR->module_path)) { + if (!COB_MODULE_PTR->module_path + || !(*COB_MODULE_PTR->module_path)) { + cob_field field; COB_FIELD_INIT (1, NULL, &const_alpha_attr); make_field_entry (&field); curr_field->size = 0; curr_field->data[0] = ' '; return curr_field; } - calcsize = strlen (*(COB_MODULE_PTR->module_path)); - COB_FIELD_INIT (calcsize, NULL, &const_alpha_attr); - make_field_entry (&field); - memcpy (curr_field->data, *(COB_MODULE_PTR->module_path), - calcsize); + cob_alloc_set_field_str (*COB_MODULE_PTR->module_path, 0, 0); return curr_field; } @@ -4243,44 +4204,39 @@ cob_intr_exception_file (void) cob_field * cob_intr_exception_location (void) { - char *buff; - cob_field field; - - COB_FIELD_INIT (0, NULL, &const_alpha_attr); /* check if last-exception is active and if LOCATION is available */ if (!cobglobptr->last_exception_id) { + cob_field field; + COB_FIELD_INIT (0, NULL, &const_alpha_attr); field.size = 1; make_field_entry (&field); *(curr_field->data) = ' '; - return curr_field; - } - buff = cob_malloc ((size_t)COB_SMALL_BUFF); - if (cobglobptr->last_exception_section && cobglobptr->last_exception_paragraph) { - snprintf (buff, (size_t)COB_SMALL_MAX, "%s; %s OF %s; %u", - cobglobptr->last_exception_id, - cobglobptr->last_exception_paragraph, - cobglobptr->last_exception_section, - cobglobptr->last_exception_line); - } else if (cobglobptr->last_exception_section) { - snprintf (buff, (size_t)COB_SMALL_MAX, "%s; %s; %u", - cobglobptr->last_exception_id, - cobglobptr->last_exception_section, - cobglobptr->last_exception_line); - } else if (cobglobptr->last_exception_paragraph) { - snprintf (buff, (size_t)COB_SMALL_MAX, "%s; %s; %u", - cobglobptr->last_exception_id, - cobglobptr->last_exception_paragraph, - cobglobptr->last_exception_line); } else { - snprintf (buff, (size_t)COB_SMALL_MAX, "%s; ; %u", - cobglobptr->last_exception_id, - cobglobptr->last_exception_line); + char buff[COB_SMALL_BUFF]; + if (cobglobptr->last_exception_section && cobglobptr->last_exception_paragraph) { + snprintf (buff, (size_t)COB_SMALL_MAX, "%s; %s OF %s; %u", + cobglobptr->last_exception_id, + cobglobptr->last_exception_paragraph, + cobglobptr->last_exception_section, + cobglobptr->last_exception_line); + } else if (cobglobptr->last_exception_section) { + snprintf (buff, (size_t)COB_SMALL_MAX, "%s; %s; %u", + cobglobptr->last_exception_id, + cobglobptr->last_exception_section, + cobglobptr->last_exception_line); + } else if (cobglobptr->last_exception_paragraph) { + snprintf (buff, (size_t)COB_SMALL_MAX, "%s; %s; %u", + cobglobptr->last_exception_id, + cobglobptr->last_exception_paragraph, + cobglobptr->last_exception_line); + } else { + snprintf (buff, (size_t)COB_SMALL_MAX, "%s; ; %u", + cobglobptr->last_exception_id, + cobglobptr->last_exception_line); + } + buff[COB_SMALL_MAX] = 0; /* silence warnings */ + cob_alloc_set_field_str (buff, 0, 0); } - buff[COB_SMALL_MAX] = 0; /* silence warnings */ - field.size = strlen (buff); - make_field_entry (&field); - memcpy (curr_field->data, buff, field.size); - cob_free (buff); return curr_field; }