From 77705f1398eea34df2bf7cd89b35d36910e1456e Mon Sep 17 00:00:00 2001 From: David Declerck Date: Wed, 30 Jul 2025 17:42:50 +0200 Subject: [PATCH 1/7] Merge SVN 5531, 5537 --- cobc/cobc.c | 1 + libcob/ChangeLog | 10 +++++----- libcob/common.c | 35 ++++----------------------------- tests/ChangeLog | 5 +++++ tests/atlocal.in | 4 ++++ tests/atlocal_win | 4 ++++ tests/testsuite.src/listings.at | 4 ++-- 7 files changed, 25 insertions(+), 38 deletions(-) diff --git a/cobc/cobc.c b/cobc/cobc.c index 6e6f8ac2e..efce4920f 100644 --- a/cobc/cobc.c +++ b/cobc/cobc.c @@ -2261,6 +2261,7 @@ set_compile_date (void) sde_todo = 1; if (s && *s) { if (cob_set_date_from_epoch (¤t_compile_time, s) == 0) { + current_compile_time.nanosecond = 0; set_compile_date_tm (); return; } diff --git a/libcob/ChangeLog b/libcob/ChangeLog index 5f9591b7c..4855b4ad1 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -1,14 +1,14 @@ +2025-05-22 David Declerck + + * common.c (cob_set_date_from_epoch): simplification, which + also fixes incorrect conversion of epoch (was off by one day) + 2025-05-21 David Declerck revert 2018-07-31 changes preferring normalization of numeric DISPLAY data including 0x00 -2025-05-19 David Declerck - - * common.c (cob_set_date_from_epoch): fix incorrect conversion - of epoch (was off by one day) - 2025-04-07 David Declerck * move.c (cob_move_display_to_packed), fileio.c (cob_file_set_key): diff --git a/libcob/common.c b/libcob/common.c index 53badf696..5f7748265 100644 --- a/libcob/common.c +++ b/libcob/common.c @@ -5243,9 +5243,7 @@ cob_get_current_datetime (const enum cob_datetime_res res) int cob_set_date_from_epoch (struct cob_time *cb_time, const unsigned char *p) { - struct tm *tmptr; - time_t t = 0; - long long seconds = 0; + cob_s64_t seconds = 0; while (IS_VALID_DIGIT_DATA (*p)) { seconds = seconds * 10 + COB_D2I (*p++); @@ -5257,36 +5255,11 @@ cob_set_date_from_epoch (struct cob_time *cb_time, const unsigned char *p) return 1; } - /* allocate tmptr for epoch */ - tmptr = localtime (&t); - /* set seconds, minutes, hours and big days */ - tmptr->tm_sec = seconds % 60; - seconds /= 60; - tmptr->tm_min = seconds % 60; - seconds /= 60; - tmptr->tm_hour = seconds % 24; - seconds /= 24; - tmptr->tm_mday = (int)seconds + 1; /* +1 because mday should be >= 1 */ - tmptr->tm_isdst = -1; - - /* normalize if needed (definitely for epoch, but also for example 30 Feb - to be changed to correct march date), - set tm_wday, tm_yday and tm_isdst */ - if (mktime (tmptr) == -1) { - return 1; - } - - cb_time->year = tmptr->tm_year + 1900; - cb_time->month = tmptr->tm_mon + 1; - cb_time->day_of_month = tmptr->tm_mday; - cb_time->hour = tmptr->tm_hour; - cb_time->minute = tmptr->tm_min; - cb_time->second = tmptr->tm_sec; + set_cob_time_from_localtime ((time_t)seconds, cb_time); cb_time->nanosecond = -1; + cb_time->offset_known = 1; + cb_time->utc_offset = 0; - cb_time->day_of_week = tmptr->tm_wday + 1; - cb_time->day_of_year = tmptr->tm_yday + 1; - cb_time->is_daylight_saving_time = tmptr->tm_isdst; return 0; } diff --git a/tests/ChangeLog b/tests/ChangeLog index 0d0794677..c5c3969e5 100644 --- a/tests/ChangeLog +++ b/tests/ChangeLog @@ -1,4 +1,9 @@ +2025-05-22 David Declerck + + * atlocal.in, atlocal_win: set TZ=UTC globally + to help get a reproducible output + 2025-05-20 David Declerck * testsuite.src/run_file.at, testsuite.src/run_misc.at, diff --git a/tests/atlocal.in b/tests/atlocal.in index f6b54fb53..8671b16e3 100644 --- a/tests/atlocal.in +++ b/tests/atlocal.in @@ -70,6 +70,10 @@ LC_ALL=C export LC_ALL unset LANG +# enforce UTC timezone +TZ=UTC +export TZ + # define for performance checks (running code several thousand times) if test "x$PERFSUFFIX" != "x" -o "x$CGSUFFIX" != "x" -o "@COB_ENABLE_DEBUG@" == yes; then if test "x$VGSUFFIX" = "x"; then diff --git a/tests/atlocal_win b/tests/atlocal_win index e51185e69..b5c993b7f 100644 --- a/tests/atlocal_win +++ b/tests/atlocal_win @@ -51,6 +51,10 @@ LC_ALL=C export LC_ALL unset LANG +# enforce UTC timezone +TZ=UTC +export TZ + # define for performance checks (running code several thousand times) # uncomment manually if wanted, or set via environment # COBOL_FLAGS="-DCHECK-PERF ${COBOL_FLAGS}" diff --git a/tests/testsuite.src/listings.at b/tests/testsuite.src/listings.at index c068351e9..273f87eb2 100644 --- a/tests/testsuite.src/listings.at +++ b/tests/testsuite.src/listings.at @@ -48,7 +48,7 @@ AT_DATA([prog.cob], [ ]) AT_DATA([expected.lst], -[GnuCOBOL V.R.P prog.cob Sat Jan 25 2002 12:00:00 Page 0001 +[GnuCOBOL V.R.P prog.cob Fri Jan 25 2002 12:00:00 Page 0001 LINE PG/LN A...B............................................................ @@ -69,7 +69,7 @@ LINE PG/LN A...B............................................................ 000015 END-DISPLAY. 000016 STOP RUN. - GnuCOBOL V.R.P prog.cob Sat Jan 25 2002 12:00:00 Page 0002 + GnuCOBOL V.R.P prog.cob Fri Jan 25 2002 12:00:00 Page 0002 0 warnings in compilation group 0 errors in compilation group From 3fedf412a9621d82469c0c9f54dd7a4c7dab387b Mon Sep 17 00:00:00 2001 From: David Declerck Date: Wed, 30 Jul 2025 22:59:48 +0200 Subject: [PATCH 2/7] Merge SVN 5540 --- ChangeLog | 5 + cobc/ChangeLog | 9 ++ cobc/cobc.c | 3 - configure.ac | 9 +- libcob/ChangeLog | 46 ++++++- libcob/Makefile.am | 4 +- libcob/cconv.c | 7 +- libcob/coblocal.h | 17 ++- libcob/common.c | 176 +++++++++++++++------------ libcob/common.h | 34 +++--- libcob/fisam.c | 13 +- libcob/numeric.c | 17 +-- libcob/strings.c | 8 +- libcob/sysdefines.h | 6 +- tests/cobol85/Makefile.am | 2 +- tests/testsuite.src/used_binaries.at | 33 +++-- 16 files changed, 249 insertions(+), 140 deletions(-) diff --git a/ChangeLog b/ChangeLog index bd5e2d1c0..3246682d6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,4 +1,9 @@ +2025-06-02 Simon Sobisch + + * configure.ac: make signal.h optional again, even if this configuration + will fail some tests + 2025-05-13 David Declerck * configure.ac: testing working diff with the option to override by DIFF diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 8a4244e24..7cf38c310 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,4 +1,9 @@ +2025-06-02 Simon Sobisch + + * cobc.c (cobc_sig_handler) [!HAVE_SIGNAL_H]: fix compile error as + now "supported" again (with missing cleanup on signal) + 2025-05-21 David Declerck revert 2018-07-31 changes preferring normalization of @@ -41,6 +46,10 @@ * gentable.c: generate EBCDIC/ASCII translation tables * cobc.c, help.c: new --gentable option +2025-01-13 Simon Sobisch + + * cobc.c: handle [__xlc__] identical to [__IBMC__] + 2024-12-09 Simon Sobisch * Makefile.am (cobc.1): add description using help2man -n diff --git a/cobc/cobc.c b/cobc/cobc.c index efce4920f..146021452 100644 --- a/cobc/cobc.c +++ b/cobc/cobc.c @@ -2413,16 +2413,13 @@ cobc_sig_handler (int sig) { #if defined (SIGINT) || defined (SIGQUIT) || defined (SIGTERM) || defined (SIGPIPE) int ret = 0; -#endif #ifdef SIGPIPE if (sig == SIGPIPE) ret = 1; #endif - if (!ret) { cobc_abort_msg (); } -#if defined (SIGINT) || defined (SIGQUIT) || defined (SIGTERM) || defined (SIGPIPE) #ifdef SIGINT if (sig == SIGINT) ret = 1; #endif diff --git a/configure.ac b/configure.ac index af1553982..a83b77481 100644 --- a/configure.ac +++ b/configure.ac @@ -701,10 +701,10 @@ AC_CACHE_SAVE dnl entries only used from external includes -> likely no need to check here dnl AC_CHECK_HEADERS([whcar.h malloc.h]) # mandatory: -AC_CHECK_HEADERS([sys/types.h signal.h stddef.h], [], +AC_CHECK_HEADERS([sys/types.h stddef.h fcntl.h], [], [AC_MSG_ERROR([mandatory header could not be found or included])]) # optional: -AC_CHECK_HEADERS([sys/time.h locale.h fcntl.h dlfcn.h stdint.h inttypes.h sys/wait.h sys/sysmacros.h]) +AC_CHECK_HEADERS([sys/time.h locale.h dlfcn.h stdint.h inttypes.h sys/wait.h sys/sysmacros.h signal.h]) # Checks for typedefs, structures, and compiler characteristics. @@ -3294,4 +3294,9 @@ case "$USE_JSON" in ;; esac +if test "$ac_cv_header_signal_h" = "no"; then + AC_MSG_NOTICE([ Signal handling not available!]) + AC_MSG_WARN([No cleanup on termination done, some tests will fail.]) +fi + unset DEFINE_DL diff --git a/libcob/ChangeLog b/libcob/ChangeLog index 4855b4ad1..aa91789b9 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -1,4 +1,11 @@ +2025-06-02 Simon Sobisch + + * common.c (cobc_sig_handler) [!HAVE_SIGNAL_H]: fix compile error as + now "supported" again (with missing cleanup on signal) + * common.c (cob_set_main_argv0) [!HAVE_REALPATH]: fix compile warning + * cconv.c (cob_load_collation): fix warning for sprintf + 2025-05-22 David Declerck * common.c (cob_set_date_from_epoch): simplification, which @@ -9,6 +16,16 @@ revert 2018-07-31 changes preferring normalization of numeric DISPLAY data including 0x00 +2025-05-19 Simon Sobisch + + * common.h: updated some defines for WIN32 compilers, especially + for VC2015's availability of snprintf + +2025-05-19 Simon Sobisch + + * fileio.c (indexed_open) [WITH_ANY_ISAM]: some GC4 backport top improve + io-status in case of errors + 2025-04-07 David Declerck * move.c (cob_move_display_to_packed), fileio.c (cob_file_set_key): @@ -23,6 +40,17 @@ * coblocal.h (cob_get_strerror): change from COB_HIDDEN to COB_EXPIMP so that other internal libraries may use it +2025-03-28 Simon Sobisch + + * common.c: move table SORT variables into the single thread-local + structure (struct sort_state), prepared for module-local with 4.x + * common.c: more static variables as thread local via COB_TLS + +2025-02-13 Simon Sobisch + + * coblocal.h: prefer C21 _Thread_local specifier for COB_TLS (also for + WIN32), dropping the need for threads.h for the previously used macro + 2025-02-11 Simon Sobisch * fileio.h: export init functions also for BDB + LMDB (see 2022-06-21) @@ -33,6 +61,11 @@ first, close the file descriptor only if the stream is NULL (fixes assertions under MSVC debug) +2025-01-13 Simon Sobisch + + * common.h, common.c: handle [__xlc__] identical to [__IBMC__] + * common.c [!SIGPIPE]: fix warning about unused jump + 2024-12-31 Simon Sobisch * common.c [WITH_EXTENDED_SCREENIO]: adjusted curses includes/defines @@ -77,6 +110,11 @@ * screenio.c [WITH_PANELS]: replace use of ncurses extension ceiling_panel() with X/Open Curses function panel_below() +2024-11-24 Simon Sobisch + + * numeric.c (mpz_get_ull, mpz_get_sll, cob_decimal_get_binary): + prefer mpz_sgn over deprecated check for size + 2024-11-22 David Declerck * move.c (optimized_move_display_to_edited): minor refactoring @@ -133,6 +171,10 @@ for any curses headers available, which now includes panel.h definitions +2024-10-25 Simon Sobisch + + * Makefile.am (HELP2MAN_OPTS): use of -n + 2024-10-22 Chuck Haatvedt * screenio.c (cob_screen_get_all): fixed Bug #999 @@ -418,8 +460,8 @@ 2024-02-26 David Declerck BUG #948: comparison with HIGH-VALUE in presence of collating sequences - * strings.c: use the collating_sequence field of cob_module to - determine the low value instead of the hard-coded constant "\0" + * strings.c (cob_update_low_value): new function to use cob_module's + collating_sequence field for determining the low value instead of the hard-coded constant "\0" 2024-01-30 Ron Norman diff --git a/libcob/Makefile.am b/libcob/Makefile.am index d00cae0e8..aee63d0e9 100644 --- a/libcob/Makefile.am +++ b/libcob/Makefile.am @@ -1,7 +1,7 @@ # # Makefile gnucobol/libcob # -# Copyright (C) 2003-2012, 2014, 2017-2023 Free Software Foundation, Inc. +# Copyright (C) 2003-2012, 2014, 2017-2024 Free Software Foundation, Inc. # Written by Keisuke Nishida, Roger While, Simon Sobisch # # This file is part of GnuCOBOL. @@ -143,7 +143,7 @@ CODE_COVERAGE_BRANCH_COVERAGE=1 CODE_COVERAGE_LCOV_OPTIONS = --no-external #HELPSOURCES = $(top_srcdir)/bin/cobcrun.c $(top_srcdir)/configure.ac -#HELP2MAN_OPTS = --info-page=$(PACKAGE) -specialflag +#HELP2MAN_OPTS = --info-page=$(PACKAGE) -n "GnuCOBOL runtime library and API functions" -h "-special -flag" #if MAKE_HAS_PREREQ_ONLY #libcob.3: $(HELPSOURCES) | $(COBCRUN) # "$(top_builddir)/pre-inst-env" $(HELP2MAN) --output=$@ $(HELP2MAN_OPTS) $(COBCRUN) diff --git a/libcob/cconv.c b/libcob/cconv.c index 6a674958b..35714225a 100644 --- a/libcob/cconv.c +++ b/libcob/cconv.c @@ -149,7 +149,7 @@ cob_load_collation (const char *col_name, ) { /* If it's a path, use it as-is, including trailing NUL */ n = strlen (col_name) + 1; - if (n >= sizeof (filename)) { + if (n >= COB_FILE_MAX) { return -1; } memcpy (filename, col_name, n); @@ -159,11 +159,10 @@ cob_load_collation (const char *col_name, if (config_dir == NULL) { config_dir = COB_CONFIG_DIR; } - n = strlen (config_dir) + strlen (col_name) + 7; /* slash + .ttbl + NUL */ - if (n >= sizeof (filename)) { + n = snprintf (filename, COB_FILE_MAX, "%s%c%s.ttbl", config_dir, SLASH_CHAR, col_name); + if (n >= COB_FILE_MAX) { return -1; } - sprintf (filename, "%s%c%s.ttbl", config_dir, SLASH_CHAR, col_name); } /* FIXME: use conf_runtime_error / adjusted cob_load_config_file later */ diff --git a/libcob/coblocal.h b/libcob/coblocal.h index 38e6c1ff3..4fbe3e1b2 100644 --- a/libcob/coblocal.h +++ b/libcob/coblocal.h @@ -1,5 +1,5 @@ /* - Copyright (C) 2007-2012, 2014-2024 Free Software Foundation, Inc. + Copyright (C) 2007-2012, 2014-2025 Free Software Foundation, Inc. Written by Roger While, Simon Sobisch, Ron Norman This file is part of GnuCOBOL. @@ -24,6 +24,12 @@ #pragma once +/* config inclusion for LSPs with file-only context; + should otherwise be included up-front */ +#ifndef COB_CONFIG_DIR +#include "config.h" +#endif + /* We use this file to define/prototype things that should not be exported to user space */ @@ -210,14 +216,13 @@ #if defined(COB_TLS) /* already defined, for example as static to explicit disable TLS */ -#elif defined(_WIN32) - #define COB_TLS __declspec(thread) +#elif defined(__STDC_VERSION__) && __STDC_VERSION__ >= 201112L + #define COB_TLS _Thread_local #elif defined(__GNUC__) && (__GNUC__ >= 4) || defined(__clang__) || \ defined(__hpux) || defined(_AIX) || defined(__sun) #define COB_TLS static __thread -#elif defined(__STDC_VERSION__) && __STDC_VERSION__ >= 201112L - #include - #define COB_TLS thread_local +#elif defined(_WIN32) + #define COB_TLS __declspec(thread) #else #define COB_TLS static /* fallback definition */ #endif diff --git a/libcob/common.c b/libcob/common.c index 5f7748265..949b69e68 100644 --- a/libcob/common.c +++ b/libcob/common.c @@ -1,5 +1,5 @@ /* - Copyright (C) 2001-2012, 2014-2024 Free Software Foundation, Inc. + Copyright (C) 2001-2012, 2014-2025 Free Software Foundation, Inc. Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman This file is part of GnuCOBOL. @@ -82,6 +82,10 @@ #ifdef HAVE_SIGNAL_H #include #endif + +#ifndef SIGABRT +#define SIGABRT 6 +#endif #ifndef SIGFPE #ifndef NSIG #define NSIG 240 @@ -305,20 +309,25 @@ static const cob_field_attr const_bin_nano_attr = {COB_TYPE_NUMERIC_BINARY, 20, 9, COB_FLAG_HAVE_SIGN, NULL}; -static char *cob_local_env = NULL; -static int current_arg = 0; -static unsigned char *commlnptr = NULL; -static size_t commlncnt = 0; -static size_t cob_local_env_size = 0; +COB_TLS char *cob_local_env = NULL; +COB_TLS size_t cob_local_env_size = 0; +COB_TLS int current_arg = 0; +COB_TLS unsigned char *commlnptr = NULL; +COB_TLS size_t commlncnt = 0; static struct cob_external *basext = NULL; -static size_t sort_nkeys = 0; -static cob_file_key *sort_keys = NULL; -static const unsigned char *sort_collate = NULL; +struct sort_state { + const unsigned char *sort_collate; + size_t sort_nkeys; + cob_file_key *sort_keys; +}; + +/* Static structure for table SORT */ +COB_TLS struct sort_state *share_sort_state = NULL; -static const char *cob_source_file = NULL; -static unsigned int cob_source_line = 0; +COB_TLS const char *cob_source_file = NULL; +COB_TLS unsigned int cob_source_line = 0; int is_test = 0; @@ -611,8 +620,8 @@ static struct config_tbl gc_conf[] = { #define NUM_CONFIG (sizeof (gc_conf) /sizeof (struct config_tbl) - 1) #define FUNC_NAME_IN_DEFAULT NUM_CONFIG + 1 -/* - * Table of 'signal' supported by this system +/* + * Table of 'signal' supported by this system */ static struct signal_table { short sig; /* Signal number */ @@ -1291,18 +1300,18 @@ cob_sig_handler (int sig) buff[pos++] = ')'; buff[pos++] = '\n'; - buff[pos++] = '\n'; - if (cob_initialized) { if (abort_reason[0] == 0) { memcpy (abort_reason, signal_text, COB_MINI_BUFF); -#if 0 /* Is there a use in this message ?*/ - pos += strcat_to_buff (buff + pos, abnormal_termination_msgid); +#if 0 /* Is there any use in this message ?*/ buff[pos++] = '\n'; + pos += strcat_to_buff (buff + pos, abnormal_termination_msgid); #endif } } + + buff[pos++] = '\n'; buff[pos] = 0; write_until_fail (STDERR_FILENO, buff, pos); @@ -1319,9 +1328,7 @@ cob_sig_handler (int sig) #ifdef SIGBUS case SIGBUS: #endif -#ifdef SIGABRT case SIGABRT: -#endif if (cobsetptr && cobsetptr->cob_core_on_error != 0) { ss_terminate_routines (); break; @@ -1332,7 +1339,9 @@ cob_sig_handler (int sig) break; } +#ifdef SIGPIPE exit_handler: +#endif /* call external signal handler if registered */ if (cob_ext_sighdl != NULL) { (*cob_ext_sighdl) (sig); @@ -2136,7 +2145,7 @@ cob_cmp_strings ( const size_t spaces_to_test = size2 - min; return -compare_spaces (data2 + min, spaces_to_test); } - + } else { /* check with collation */ /* Compare common substring */ @@ -2182,17 +2191,20 @@ sort_compare (const void *data1, const void *data2) cob_field f1; cob_field f2; + const size_t sort_nkeys = share_sort_state->sort_nkeys; + for (i = 0; i < sort_nkeys; ++i) { - f1 = f2 = *sort_keys[i].field; - f1.data = (unsigned char *)data1 + sort_keys[i].offset; - f2.data = (unsigned char *)data2 + sort_keys[i].offset; + const cob_file_key sort_key = share_sort_state->sort_keys[i]; + f1 = f2 = *sort_key.field; + f1.data = (unsigned char *)data1 + sort_key.offset; + f2.data = (unsigned char *)data2 + sort_key.offset; if (COB_FIELD_IS_NUMERIC (&f1)) { res = cob_numeric_cmp (&f1, &f2); } else { res = memcmp (f1.data, f2.data, f1.size); } if (res != 0) { - return (sort_keys[i].tf_ascending == COB_ASCENDING) ? res : -res; + return (sort_key.tf_ascending == COB_ASCENDING) ? res : -res; } } return 0; @@ -2208,17 +2220,20 @@ sort_compare_collate (const void *data1, const void *data2) cob_field f1; cob_field f2; + const size_t sort_nkeys = share_sort_state->sort_nkeys; + for (i = 0; i < sort_nkeys; ++i) { - f1 = f2 = *sort_keys[i].field; - f1.data = (unsigned char *)data1 + sort_keys[i].offset; - f2.data = (unsigned char *)data2 + sort_keys[i].offset; + const cob_file_key sort_key = share_sort_state->sort_keys[i]; + f1 = f2 = *sort_key.field; + f1.data = (unsigned char *)data1 + sort_key.offset; + f2.data = (unsigned char *)data2 + sort_key.offset; if (COB_FIELD_IS_NUMERIC (&f1)) { res = cob_numeric_cmp (&f1, &f2); } else { - res = cob_cmps (f1.data, f2.data, f1.size, sort_collate); + res = cob_cmps (f1.data, f2.data, f1.size, share_sort_state->sort_collate); } if (res != 0) { - return (sort_keys[i].tf_ascending == COB_ASCENDING) ? res : -res; + return (sort_key.tf_ascending == COB_ASCENDING) ? res : -res; } } return 0; @@ -3084,7 +3099,7 @@ cob_realloc (void * optr, const size_t osize, const size_t nsize) if (osize == nsize) { /* No size change */ return optr; - } + } if (osize > nsize) { /* Reducing size */ return realloc (optr, nsize); } @@ -3547,12 +3562,16 @@ cob_hard_failure () } call_exit_handlers_and_terminate (); } + /* the internal exit code can, in theory, also + be queried by installed signal handlers */ exit_code = -1; + #ifndef COB_WITHOUT_JMP if (return_jmp_buffer_set) { longjmp (return_jmp_buf, -1); } #endif + /* if explicit requested for errors or an explicit manual coredump creation did not work raise an abort here */ @@ -4466,7 +4485,7 @@ cob_is_numeric (const cob_field *f) register const unsigned char *p = f->data; const unsigned char *end = p + f->size - 1; - /* Check sign */ + /* Check sign */ { const char sign = *end & 0x0F; if (COB_FIELD_NO_SIGN_NIBBLE (f)) { @@ -4592,34 +4611,39 @@ cob_is_lower (const cob_field *f) void cob_table_sort_init (const size_t nkeys, const unsigned char *collating_sequence) { - sort_nkeys = 0; - sort_keys = cob_malloc (nkeys * sizeof (cob_file_key)); - if (collating_sequence) { - sort_collate = collating_sequence; - } else { - sort_collate = COB_MODULE_PTR->collating_sequence; - } + share_sort_state = cob_malloc (sizeof(struct sort_state)); + share_sort_state->sort_collate = collating_sequence ? collating_sequence + : COB_MODULE_PTR->collating_sequence; + share_sort_state->sort_nkeys = 0; + share_sort_state->sort_keys = cob_malloc (nkeys * sizeof (cob_file_key)); + /* TODO on merge to 4.x: consider to + return sort_state; ... or pass by reference -> dropping share_sort_state */ } void cob_table_sort_init_key (cob_field *field, const int flag, const unsigned int offset) { - sort_keys[sort_nkeys].field = field; - sort_keys[sort_nkeys].tf_ascending = flag; - sort_keys[sort_nkeys].offset = offset; - sort_nkeys++; + /* TODO on merge to 4.x: add sort_state as parameter */ + cob_file_key *sort_key = &share_sort_state->sort_keys[share_sort_state->sort_nkeys++]; + sort_key->field = field; + sort_key->tf_ascending = flag; + sort_key->offset = offset; } void cob_table_sort (cob_field *f, const int n) { - if (sort_collate) { + /* TODO on merge to 4.x: check if qsort_r is available, if yes pass sort_state, + if not use share_sort_state and qsort */ + if (share_sort_state->sort_collate) { qsort (f->data, (size_t) n, f->size, sort_compare_collate); } else { qsort (f->data, (size_t) n, f->size, sort_compare); } - cob_free (sort_keys); + cob_free (share_sort_state->sort_keys); + cob_free (share_sort_state); + share_sort_state = NULL; } /* Run-time error checking */ @@ -4985,7 +5009,7 @@ static set_cob_time_from_localtime (time_t curtime, static time_t last_time = 0; static struct cob_time last_cobtime; - + /* FIXME: on setting related locale set last_time = 0 */ if (curtime == last_time) { memcpy (cb_time, &last_cobtime, sizeof (struct cob_time)); @@ -5767,6 +5791,8 @@ cob_accept_microsecond_time (cob_field *f) void cob_display_command_line (cob_field *f) { + /* FIXME: should raise (and codegen check) an exception + if malloc is not possible */ if (commlnptr) { cob_free (commlnptr); } @@ -5783,7 +5809,7 @@ cob_accept_command_line (cob_field *f) size_t size; size_t len; - if (commlncnt) { + if (commlnptr) { cob_move_intermediate (f, commlnptr, commlncnt); return; } @@ -6262,7 +6288,7 @@ check_valid_dir (const char *dir) #if 0 print_stat (dir, sb); #endif - + return 0; } @@ -8527,7 +8553,7 @@ set_config_val (char *value, int pos) str = cob_expand_env_string (value); memcpy (data, &str, sizeof (char *)); if (data_loc == offsetof (cob_settings, cob_preload_str)) { - cobsetptr->cob_preload_str_set = cob_strdup(str); + cobsetptr->cob_preload_str_set = cob_strdup (str); } /* call internal routines that do post-processing */ @@ -9149,7 +9175,7 @@ cob_runtime_warning_external (const char *caller_name, const int cob_reference, cob_get_source_line (); get_source_location (buff); fprintf (stderr, "%s", buff); - } + } fprintf (stderr, _("warning: ")); if (!(caller_name && *caller_name)) caller_name = "unknown caller"; @@ -9562,7 +9588,7 @@ cob_fatal_error (const enum cob_fatal_error fatal_error) break; case COB_FERROR_JSON: cob_runtime_error (_("attempt to use non-implemented JSON I/O")); - break; + break; default: /* internal rare error, no need for translation */ cob_runtime_error ("unknown failure: %d", fatal_error); @@ -9732,7 +9758,7 @@ get_screenio_and_mouse_info (char *version_buffer, size_t size, const int verbos } else { snprintf (buff, 55, _("%s, version %s"), WITH_CURSES, version_buffer); } -#if defined (RESOLVED_PDC_VER) +#if defined (RESOLVED_PDC_VER) { const int chtype_val = (int)sizeof (chtype) * 8; char chtype_def[10] = { '\0' }; @@ -9921,7 +9947,7 @@ print_version_summary (void) if(!cob_initialized) cob_init_nomain (0, NULL); set_cob_build_stamp (cob_build_stamp); - + printf ("%s %s (%s), ", PACKAGE_NAME, libcob_version(), cob_build_stamp); @@ -10529,7 +10555,7 @@ cob_call_with_exception_check (const char *name, const int argc, void **argv) ret = setjmp (return_jmp_buf); if (ret) { return_jmp_buffer_set = 0; - /* Module unloading has been requested (after being postponed): perform it */ + /* Module unloading has been requested (after being postponed): perform it */ if (module_unload == COB_REQUESTED) { cob_exit_call (); cob_exit_cobcapi (); @@ -10538,7 +10564,7 @@ cob_call_with_exception_check (const char *name, const int argc, void **argv) module_unload = COB_IMMEDIATE; return ret; } - /* Set module unloading to be postponed (until longjmp is performed) */ + /* Set module unloading to be postponed (until longjmp is performed) */ module_unload = COB_POSTPONE; #endif exit_code = cob_call (name, argc, argv); @@ -10550,21 +10576,21 @@ cob_call_with_exception_check (const char *name, const int argc, void **argv) static void cob_set_main_argv0 (const int argc, char **argv) { - char *s; #if defined (HAVE_READLINK) || defined (HAVE_GETEXECNAME) const char *path; #endif - int i; #ifdef _WIN32 - s = cob_malloc ((size_t)COB_MEDIUM_BUFF); - i = GetModuleFileNameA (NULL, s, COB_MEDIUM_MAX); - if (i > 0 && i < COB_MEDIUM_BUFF) { - cobglobptr->cob_main_argv0 = cob_strdup (s); + { + char *s = cob_malloc ((size_t)COB_MEDIUM_BUFF); + int i = GetModuleFileNameA (NULL, s, COB_MEDIUM_MAX); + if (i > 0 && i < COB_MEDIUM_BUFF) { + cobglobptr->cob_main_argv0 = cob_strdup (s); + cob_free (s); + return; + } cob_free (s); - return; } - cob_free (s); #endif #ifdef HAVE_READLINK if (!access ("/proc/self/exe", R_OK)) { @@ -10577,8 +10603,8 @@ void cob_set_main_argv0 (const int argc, char **argv) path = NULL; } if (path) { - s = cob_malloc ((size_t)COB_MEDIUM_BUFF); - i = (int)readlink (path, s, (size_t)COB_MEDIUM_MAX); + char *s = cob_malloc ((size_t)COB_MEDIUM_BUFF); + int i = (int)readlink (path, s, (size_t)COB_MEDIUM_MAX); if (i > 0 && i < COB_MEDIUM_BUFF) { s[i] = 0; cobglobptr->cob_main_argv0 = cob_strdup (s); @@ -10593,7 +10619,7 @@ void cob_set_main_argv0 (const int argc, char **argv) path = getexecname (); if (path) { #ifdef HAVE_REALPATH - s = cob_malloc ((size_t)COB_MEDIUM_BUFF); + char *s = cob_malloc ((size_t)COB_MEDIUM_BUFF); if (realpath (path, s) != NULL) { cobglobptr->cob_main_argv0 = cob_strdup (s); } else { @@ -10634,7 +10660,7 @@ cob_init (const int argc, char **argv) #ifdef __GLIBC__ { - /* + /* * GNU libc may write a stack trace to /dev/tty when malloc * detects corruption. If LIBC_FATAL_STDERR_ is set to any * nonempty string, it writes to stderr instead. See: @@ -10653,13 +10679,11 @@ cob_init (const int argc, char **argv) cob_last_sfile = NULL; commlnptr = NULL; basext = NULL; - sort_keys = NULL; - sort_collate = NULL; + share_sort_state = NULL; cob_source_file = NULL; exit_hdlrs = NULL; hdlrs = NULL; commlncnt = 0; - sort_nkeys = 0; cob_source_line = 0; cob_local_env_size = 0; @@ -10907,7 +10931,7 @@ cob_get_runtime_option (enum cob_runtime_option_switch opt) } /* output the COBOL-view of the stacktrace to the given target, - does an early exit if 'target' is NULL, + does an early exit if 'target' is NULL, 'target' is FILE * and should be flushed before */ void cob_stack_trace (void *target) @@ -10975,7 +10999,7 @@ output_procedure_stack_entry (char *buff, if (!section && !paragraph) { return 0; } - + buff[pos++] = '\n'; buff[pos++] = '\t'; if (section && paragraph) { @@ -11863,14 +11887,14 @@ cob_debug_logger (const char *fmt, ...) } static int /* Return TRUE if word is repeated 16 times */ -repeatWord( +repeatWord ( char *match, /* 4 bytes to match */ char *mem) /* Memory area to match repeated value */ { - if(memcmp(match, &mem[0], 4) == 0 - && memcmp(match, &mem[4], 4) == 0 - && memcmp(match, &mem[8], 4) == 0 - && memcmp(match, &mem[12], 4) == 0) + if (memcmp (match, &mem[0], 4) == 0 + && memcmp (match, &mem[4], 4) == 0 + && memcmp (match, &mem[8], 4) == 0 + && memcmp (match, &mem[12], 4) == 0) return 1; return 0; } diff --git a/libcob/common.h b/libcob/common.h index 4ea567076..22e407500 100644 --- a/libcob/common.h +++ b/libcob/common.h @@ -1,5 +1,5 @@ /* - Copyright (C) 2002-2012, 2014-2024 Free Software Foundation, Inc. + Copyright (C) 2002-2012, 2014-2025 Free Software Foundation, Inc. Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman, Edward Hart @@ -331,18 +331,15 @@ typedef __mpz_struct mpz_t[1]; #define strncasecmp _strnicmp #define strcasecmp _stricmp +#if !COB_USE_VC2015_OR_GREATER +/* VC2015+ provides standard function with plain + name, old posix emulation with underscore */ #define snprintf _snprintf +#endif #define getpid _getpid #define access _access #define popen _popen #define pclose _pclose -/* MSDN says these are available since VC2005 #if COB_USE_VC2013_OR_GREATER -only usable with COB_USE_VC2013_OR_GREATER */ -#define timezone _timezone -#define tzname _tzname -#define daylight _daylight -/* only usable with COB_USE_VC2013_OR_GREATER - End -#endif */ #if !COB_USE_VC2013_OR_GREATER #define atoll _atoi64 @@ -367,16 +364,14 @@ only usable with COB_USE_VC2013_OR_GREATER */ #define strcasecmp stricmp #define _setmode setmode #define _chdir chdir -#define timezone _timezone -#define tzname _tzname -#define daylight _daylight -#endif /* __BORLANDC__ */ +#endif -#ifdef __ORANGEC__ +#if defined (_MSC_VER) || defined (__ORANGEC__) \ + || defined (_UCRT) || defined (__BORLANDC__) #define timezone _timezone #define tzname _tzname #define daylight _daylight -#endif /* _ORANGEC__ */ +#endif #if __SUNPRO_C /* Disable certain warnings */ @@ -416,10 +411,15 @@ only usable with COB_USE_VC2013_OR_GREATER */ #define COB_INLINE #endif +/* note: we previously checked only for __xlc__, now only for __IBMC__ */ +#if defined (__xlc__) && !defined(__IBMC__) + #define __IBMC__ __xlc__ +#endif + /* Also OK for icc which defines __GNUC__ */ #if defined(__GNUC__) || \ - (defined(__xlc__) && __IBMC__ >= 700 ) || \ + (defined(__IBMC__) && __IBMC__ >= 700 ) || \ (defined(__HP_cc) && __HP_cc >= 61000) #define COB_A_NORETURN __attribute__((noreturn)) #define COB_A_FORMAT12 __attribute__((format(printf, 1, 2))) @@ -466,7 +466,7 @@ only usable with COB_USE_VC2013_OR_GREATER */ #define COB_A_COLD #endif -#elif defined(__xlc__) && __IBMC__ >= 700 +#elif defined(__IBMC__) && __IBMC__ >= 700 #define COB_NOINLINE __attribute__((noinline)) #define COB_A_INLINE __attribute__((always_inline)) @@ -1407,7 +1407,7 @@ typedef struct __cob_module { unsigned char flag_pretty_display; /* Pretty display */ unsigned char flag_host_sign; /* Host sign */ - unsigned char flag_no_phys_canc; /* No physical cancel */ + unsigned char flag_no_phys_canc; /* No physical cancel (constant by cobc)*/ unsigned char flag_main; /* Main module */ unsigned char flag_fold_call; /* Fold case */ unsigned char flag_exit_program; /* Exit after CALL */ diff --git a/libcob/fisam.c b/libcob/fisam.c index ca8dc20e5..134389f49 100644 --- a/libcob/fisam.c +++ b/libcob/fisam.c @@ -1093,18 +1093,27 @@ isam_open (cob_file_api *a, cob_file *f, char *filename, const enum cob_open_mod vmode |= (omode | lmode | fmode); isfd = isbuild ((void *)filename, (int)f->record_max, &fh->key[0], vmode); if (isfd < 0) { - if (ISERRNO == EFLOCKED) + if (ISERRNO == EFLOCKED) { return COB_STATUS_61_FILE_SHARING; - if ((ISERRNO == EEXIST || ISERRNO == EBADARG)) { + } + if ((ISERRNO == EEXIST || ISERRNO == EBADARG) +#if 1 /* CHECKME: guard added by Simon, needed ? */ + && omode == ISOUTPUT +#endif + ) { /* Erase file and redo the 'isbuild' */ isam_file_delete (a, f, filename); +#if ISVARLEN != 0 if (f->record_min != f->record_max) { ISRECLEN = f->record_min; } +#endif ISERRNO = 0; isfd = isbuild ((void *)filename, (int)f->record_max, &fh->key[0], vmode); f->flag_file_lock = 1; } + /* TODO: more checks in case isfd < 0, + allowing better io status than 30 */ } else { f->flag_file_lock = 1; } diff --git a/libcob/numeric.c b/libcob/numeric.c index 35f6e5212..3d363675f 100644 --- a/libcob/numeric.c +++ b/libcob/numeric.c @@ -859,7 +859,7 @@ cob_decimal_get_double (cob_decimal *d) double v; cob_not_finite = 0; - if (mpz_size (d->value) == 0) { + if (mpz_sgn (d->value) == 0) { return 0.0; } cob_decimal_get_mpf (cob_mpft, d); @@ -1640,20 +1640,21 @@ static int cob_decimal_get_binary (cob_decimal *d, cob_field *f, const int opt) { const int field_sign = COB_FIELD_HAVE_SIGN (f); - const size_t bitnum = (f->size * 8) - field_sign; + const int sign = mpz_sgn (d->value); + const size_t bitnum = f->size * 8; size_t overflow; - if (mpz_size (d->value) == 0) { + if (sign == 0) { memset (f->data, 0, f->size); return 0; } overflow = 0; if (!field_sign - && mpz_sgn (d->value) == -1) { + && sign == -1) { mpz_abs (d->value, d->value); } if (f->size > sizeof(cob_u64_t)) { - int neg; + int neg; size_t size; size_t sizeb; size_t count; @@ -1700,7 +1701,7 @@ cob_decimal_get_binary (cob_decimal *d, cob_field *f, const int opt) } return 0; } - if (mpz_sizeinbase (d->value, 2) > bitnum) { + if (mpz_sizeinbase (d->value, 2) > bitnum - field_sign) { if (opt & COB_STORE_KEEP_ON_OVERFLOW) { goto overflow; } @@ -1717,7 +1718,7 @@ cob_decimal_get_binary (cob_decimal *d, cob_field *f, const int opt) } mpz_tdiv_r (d->value, d->value, cob_mpze10[digits]); } else { - mpz_fdiv_r_2exp (d->value, d->value, (f->size * 8)); + mpz_fdiv_r_2exp (d->value, d->value, bitnum); } } else if (opt && COB_FIELD_BINARY_TRUNC (f)) { const short scale = COB_FIELD_SCALE (f); @@ -1739,7 +1740,7 @@ cob_decimal_get_binary (cob_decimal *d, cob_field *f, const int opt) mpz_tdiv_r (d->value, d->value, cob_mpze10[digits]); } else { - mpz_fdiv_r_2exp (d->value, d->value, (f->size * 8)); + mpz_fdiv_r_2exp (d->value, d->value, bitnum); } } } diff --git a/libcob/strings.c b/libcob/strings.c index 00f23343d..11d509e14 100644 --- a/libcob/strings.c +++ b/libcob/strings.c @@ -101,6 +101,7 @@ static const cob_field_attr const_alpha_attr = static const cob_field_attr const_strall_attr = {COB_TYPE_ALPHANUMERIC_ALL, 0, 0, 0, NULL}; +/* Static structures for string related statements */ COB_TLS struct cob_inspect_state share_inspect_state; COB_TLS struct cob_string_state share_string_state; COB_TLS struct cob_unstring_state share_unstring_state; @@ -340,7 +341,7 @@ inspect_common_no_replace ( } /* set the marker so we won't iterate over this area again */ if (n) { - set_inspect_mark (st, pos, last_marker); + set_inspect_mark (st, pos, last_marker + 1); } /* note: same code as for LEADING, moved out as we don't need to check LEADING for _every_ byte in that tight loop */ @@ -537,7 +538,6 @@ cob_inspect_init_common_intern (struct cob_inspect_state *st, cob_field *var) st->data = COB_FIELD_DATA (var); st->start = NULL; st->end = NULL; - st->mark_size = 0; st->repdata_size = 0; cobglobptr->cob_exception_code = 0; @@ -578,7 +578,7 @@ cob_inspect_init (cob_field *var, const cob_u32_t replacing) cob_inspect_start (setting start/end) cob_inspect_before (optional, adjusting end) cob_inspect_after (optional, adjusting start) - one-time cob_inspect_converting/cob_inspect_translating (actual converstion) */ + one-time cob_inspect_converting/cob_inspect_translating (actual conversion) */ static void cob_inspect_init_converting_intern (struct cob_inspect_state *st, cob_field *var) @@ -691,7 +691,7 @@ cob_inspect_characters_intern (struct cob_inspect_state *st, cob_field *f1) void cob_inspect_characters (cob_field *f1) { - cob_inspect_characters_intern(&share_inspect_state, f1); + cob_inspect_characters_intern (&share_inspect_state, f1); } static void diff --git a/libcob/sysdefines.h b/libcob/sysdefines.h index 82be4997f..b4f184bbf 100644 --- a/libcob/sysdefines.h +++ b/libcob/sysdefines.h @@ -53,9 +53,9 @@ #endif #define GC_C_VERSION CB_XSTRINGIFY(__VERSION__) -#elif defined(__xlc__) +#elif defined(__IBMC__) /* note: defined from __xlc__, if missing */ #define GC_C_VERSION_PRF "(IBM XL C/C++) " -#define GC_C_VERSION CB_XSTRINGIFY(__xlc__) +#define GC_C_VERSION CB_XSTRINGIFY(__IBMC__) #elif defined(__SUNPRO_C) #define GC_C_VERSION_PRF "(Sun C) " @@ -142,7 +142,7 @@ #define CB_COPT_3 " -xO2" /* CHECKME: Oracle docs are confusing, is -xO3 working? */ #define CB_COPT_S " -xO1 -xspace" -#elif defined(__xlc__) +#elif defined(__IBMC__) /* note: defined from __xlc__, if missing */ #define CB_COPT_0 " -O0" #define CB_COPT_1 " -O" #define CB_COPT_2 " -O2" diff --git a/tests/cobol85/Makefile.am b/tests/cobol85/Makefile.am index 78fb71416..3b68d995d 100644 --- a/tests/cobol85/Makefile.am +++ b/tests/cobol85/Makefile.am @@ -43,7 +43,7 @@ MODULES_RUN = NC_RUN SQ_RUN IX_RUN IF_RUN ST_RUN \ SUMMARY = summarynoix.txt endif -# currently down, leading to se possibly not available +[AT_CHECK([$COBC --gentable=ISO8859-1,UTF-8], [1], [], +[error: conversion from ISO8859-1 to UTF-8 is not supported by your iconv implementation +])]) + + +# some environments don't have IBM-500 (like old MSYS and MSVC variants) +# others don't support this conversion (like Solaris 11) - in this case +# we skip the rest of the test +AT_SKIP_IF([test "$($COBC --gentable=IBM500,ASCII 2>&1)" \ + = "error: conversion from IBM500 to ASCII is not supported by your iconv implementation"]) + + AT_CHECK([$COBC --gentable=IBM500,ASCII], [0], [# GnuCOBOL IBM500 <-> ASCII translation tables @@ -1559,12 +1580,4 @@ D8 D9 DA DB DC DD DE DF E0 E1 E2 7C E3 E4 E5 E6 ], [note: 128 non-reversible conversions have been arbitrarily made reversible, you may want to check the generated table ]) -AT_CHECK([$COBC --gentable=IBM500,UTF-8], [1], [], -[error: an error occurred after converting 172 characters -]) - -AT_CHECK([$COBC --gentable=EBCDIC_XXX,ASCII_XXX], [1], [], -[error: conversion from EBCDIC_XXX to ASCII_XXX is not supported by your iconv implementation -]) - AT_CLEANUP From f4232ac38c125b34d34026019f77221adb05e2b9 Mon Sep 17 00:00:00 2001 From: David Declerck Date: Thu, 31 Jul 2025 10:04:51 +0200 Subject: [PATCH 3/7] Merge 5541, 5542 --- NEWS | 41 +- TODO | 5 + config/ChangeLog | 5 + config/runtime.cfg | 19 +- libcob/ChangeLog | 47 +- libcob/coblocal.h | 2 + libcob/common.c | 2 + libcob/common.h | 7 + libcob/fileio.c | 406 +++++++++- libcob/system.def | 10 +- tests/testsuite.src/run_file.at | 978 ++++++++++++++++++++++++- tests/testsuite.src/run_fundamental.at | 14 +- 12 files changed, 1501 insertions(+), 35 deletions(-) diff --git a/NEWS b/NEWS index f4990000a..e68801e4a 100644 --- a/NEWS +++ b/NEWS @@ -99,7 +99,7 @@ Open Plans: ** cobc now checks for binary and multi-byte encoded files and early exit parsing those; the error output for format errors (for example invalid - indicator column) is now limitted to 5 per source file + indicator column) is now limited to 5 per source file ** support the COLLATING SEQUENCE clause on indexed files (currently only with the BDB backend) @@ -116,6 +116,21 @@ Open Plans: ** added multiple window functionality with new system function CBL_GC_WINDOW +** New system functions + + CBL_OPEN_VFILE opens a "virtual file" (heap) + CBL_WRITE_VFILE writes bytes to heap; offset 4 byte binary + CBL_READ_VFILE reads bytes from heap; offset 4 byte binary + CBL_CLOSE_VFILE closes the heap handle + CBL_GC_OPEN_VFILE64 opens a "virtual file" (heap) + CBL_GC_WRITE_VFILE64 writes bytes to heap; offset 8 byte binary + CBL_GC_READ_VFILE64 reads bytes from heap; offset 8 byte binary + CBL_GC_CLOSE_VFILE64 closes the heap handle + The VFILE functions provide functionality consistent with Microfocus / + Fujitsu, but the heap is never paged to disk. + The VFILE64 functions are a GnuCOBOL extension to allow for access beyond the + 4 GB offset when using the 64 bit environment. + more work in progress * Changes that potentially effect recompilation of existing programs: @@ -154,7 +169,7 @@ Open Plans: to this compiler option. ** output of unlimited errors may be requested by -fmax-errors=0, - to stop compiliation at first error use -Wfatal-errors + to stop compilation at first error use -Wfatal-errors ** default value for -fmax-errors was changed from 128 to 20 ** New option -fdiagnostics-absolute-paths to print the full path of @@ -205,7 +220,7 @@ Open Plans: package manager version) ** use the "default" -shared flag to build dynamic libraries on macOS - so as to fix testuite issues with recent macOS versions + so as to fix testsuite issues with recent macOS versions ** "make checkmanual" was extended to be also usable with tmux and allows to override the test runner and to attach for screen/tmux sessions, @@ -279,8 +294,8 @@ For more known issues see the bug tracker. ** Support for additional $SET directives: ODOSLIDE -** Support for the EXTFH interface was heavily improved, now also supporting - FH--FCD and FH--KEYDEF, fixed use of different attributes and changing +** Support for the EXTFH has been greatly enhanced and now includes support + for FH--FCD and FH--KEYDEF, fixed use of different attributes and changing pointers and now supports - for 32-bit builds - an internal conversion between FCD2 and FCD3 for cases where existing programs are coded with FCD2 @@ -327,6 +342,19 @@ For more known issues see the bug tracker. this isn't done anymore so if you need the memory to be initialized specify that explicit in the source and recompile +** variable-length RECORD SEQUENTIAL files, data validation on READ: + the length of the record as stored in the file is now checked for correct + format and is then compared against the record size defined in the program; + if the minimal record size specified is bigger, then the data is only + written up to the record length for that record, the other data is + undefined and io status 04 returned; if the record length is bigger than + the record size the record from the file is truncated, io status 04 set + and the following READ will start at the next record; + additionally on OPEN the length of the first record is read and if it + isn't within the above rules, an io status 39 is returned; as the default + format "COB_VARSEQ_TYPE = 0" contains two NULL bytes this will likely + make most LINE SEQUENTIAL files not declared as this type fail on OPEN + ** LINE SEQUENTIAL files, data validation: in case of bad printable data (less than SPACE) a READ may result in io status 09 and WRITE may error with io status 71; see the new runtime option COB_LS_VALIDATE to disable @@ -569,6 +597,9 @@ For more known issues see the bug tracker. ** new compiler command line option to list the known runtime exception names and fatality `cobc --list-exceptions` +** new compiler command line option to output the exact version number + `cobc -dumpversion` + ** new compiler command line option -ftcmd to enable printing of the command line in the source listing, -fno-timestamp to suppress printing of the time and -ftittle to set a title instead of GnuCOBOL and version (_ chars are diff --git a/TODO b/TODO index 11c43ddf7..dbdf1a446 100644 --- a/TODO +++ b/TODO @@ -263,3 +263,8 @@ https://sourceforge.net/p/gnucobol/code/HEAD/tree/external-doc/guide/ - Check use of new integer optimization in cb_build_optim_sub and cb_build_optim_add - those may be slower than cob_add_packed_int/cob_add_packed_int64 - If there's a reasonable performance benefit for the integer optimizations for BCD/DISPLAY: add an option -funsigned-zero which never stores a sign in those (or in one of those, depending on a perf stat result) to provide the option to still use this optimization + + +For vfile routines: document return-codes per fileio.c and different +handling of cancel and heap-status variable used in CBL_OPEN_VFILE only +and no use of backup file, limitation of i/o area length. diff --git a/config/ChangeLog b/config/ChangeLog index 9ba1f8835..3dfb8f3e3 100644 --- a/config/ChangeLog +++ b/config/ChangeLog @@ -1,4 +1,9 @@ +2025-04-22 Chuck Haatvedt + + * runtime.cfg: add runtime configuration COB_HEAP_MEMORY and + COB_HEAP_MEMORY64 to support VFILES memory allocation + 2025-01-10 David Declerck * gcos-strict.conf: set init-justify to no after testing on GCOS diff --git a/config/runtime.cfg b/config/runtime.cfg index 45b28d7a1..976e0caa8 100644 --- a/config/runtime.cfg +++ b/config/runtime.cfg @@ -1,6 +1,6 @@ # GnuCOBOL runtime configuration # -# Copyright (C) 2015-2024 Free Software Foundation, Inc. +# Copyright (C) 2015-2025 Free Software Foundation, Inc. # Written by Simon Sobisch, Ron Norman # # This file is part of the GnuCOBOL runtime. @@ -569,6 +569,23 @@ # When 'false' a ROLLBACK of pending updates will be done # Example: stop_run_commit=true +# Environment name: COB_HEAP_MEMORY +# Parameter name: heap_memory +# Purpose: Defines how much RAM to use when allocating segments +# of memory to be used by the VIRTAUL HEAP functions. +# Type: size but must be between 16K and 64M +# Default: 1M +# Example: HEAP_MEMORY 1M + +# Environment name: COB_HEAP_MEMORY_64 +# Parameter name: heap_memory_64 +# Purpose: Defines how much RAM to use when allocating segments +# of memory to be used by the VIRTAUL HEAP functions +# when using the 64 bit READ / WRITE VFILE versions. +# Type: size but must be >= 256K +# Default: 64M +# Example: HEAP_MEMORY_64 128M + # Environment name: COB_SORT_MEMORY # Parameter name: sort_memory # Purpose: Defines how much RAM to assign for sorting data diff --git a/libcob/ChangeLog b/libcob/ChangeLog index aa91789b9..17cd150df 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -1,4 +1,18 @@ +2025-06-03 Simon Sobisch + + first VFILE update + * fileio.c: drop some debugging code, also fixing SIGSEGV on not opened + debug logfile + * fileio.c: refactored, removing nearly all static vars on the way + * fileio.c, system.def, common.h: seperate internal function + for CBL_GC_OPEN_VFILE64; now using the runtime setting for memory + allocation depending on the heap's alloc size + * fileio.c (SEG_HDR, HEAP_ENTRY) [!_DEBUG]: only provide eyeball in + debug builds + * fileio.c (SEG_HDR, HEAP_ENTRY): drop unused fields + * fileio.c: adjusted vfile functions per changes in SEG_HDR and HEAP_ENTRY + 2025-06-02 Simon Sobisch * common.c (cobc_sig_handler) [!HAVE_SIGNAL_H]: fix compile error as @@ -26,11 +40,28 @@ * fileio.c (indexed_open) [WITH_ANY_ISAM]: some GC4 backport top improve io-status in case of errors -2025-04-07 David Declerck - - * move.c (cob_move_display_to_packed), fileio.c (cob_file_set_key): - make casts with loss of data explicit using masking to silence - the MSVC runtime error checker +2025-04-22 Chuck Haatvedt + + new functions to support virtual heap + CBL_ functions from Fujitsu and Microfocus COBOL compilers + * fileio.c (cob_sys_open_vfile, + cob_sys_read_vfile + cob_sys_read_vfile2, + cob_sys_write_vfile, + cob_sys_write_vfile2, + cob_sys_close_vfile, + get_default_alloc, + create_first_segment, + get_new_segment, + locate_segment): + note that as CBL_GC extension we also support a 64 bit + version which allows for a VFILE to exceed the 4GB + limitation if memory is available + * coblocal.h: added new variables to support runtime additions + of heap memory for use with VFILES + * common.h, system.def: added new definitions for VFILES support + * common.c: (config_tbl gc_conf) added new entries for + VFILE default memory allocation size 2025-04-14 David Declerck @@ -40,6 +71,12 @@ * coblocal.h (cob_get_strerror): change from COB_HIDDEN to COB_EXPIMP so that other internal libraries may use it +2025-04-07 David Declerck + + * move.c (cob_move_display_to_packed), fileio.c (cob_file_set_key): + make casts with loss of data explicit using masking to silence + the MSVC runtime error checker + 2025-03-28 Simon Sobisch * common.c: move table SORT variables into the single thread-local diff --git a/libcob/coblocal.h b/libcob/coblocal.h index 4fbe3e1b2..48efbbd2a 100644 --- a/libcob/coblocal.h +++ b/libcob/coblocal.h @@ -294,6 +294,8 @@ typedef struct __cob_settings { char *cob_file_path; char *bdb_home; char *lmdb_home; + size_t cob_heap_memory; /* Memory segment for VFILE */ + size_t cob_heap_memory_64; /* Memory segment for VFILE 64 */ size_t cob_sort_memory; size_t cob_sort_chunk; diff --git a/libcob/common.c b/libcob/common.c index 949b69e68..8dddcf0dd 100644 --- a/libcob/common.c +++ b/libcob/common.c @@ -602,6 +602,8 @@ static struct config_tbl gc_conf[] = { {"COB_DUPS_AHEAD","dups_ahead", "default",dups_opts,GRP_FILE,ENV_UINT|ENV_ENUMVAL,SETPOS(cob_file_dups),0,3}, {"COB_SEQ_CONCAT_NAME","seq_concat_name","0",NULL,GRP_FILE,ENV_BOOL,SETPOS(cob_concat_name)}, {"COB_SEQ_CONCAT_SEP","seq_concat_sep","+",NULL,GRP_FILE,ENV_CHAR,SETPOS(cob_concat_sep),1}, + {"COB_HEAP_MEMORY", "heap_memory", "1M", NULL, GRP_FILE, ENV_SIZE, SETPOS (cob_heap_memory), (16*1024), (64 * 1024 * 1024)}, + {"COB_HEAP_MEMORY_64", "heap_memory_64", "64M", NULL, GRP_FILE, ENV_SIZE, SETPOS (cob_heap_memory_64), (256*1024), 4294967294UL /* max. guaranteed - 1 */}, #ifdef WITH_DB {"DB_HOME", "db_home", NULL, NULL, GRP_FILE, ENV_FILE, SETPOS (bdb_home)}, #endif diff --git a/libcob/common.h b/libcob/common.h index 22e407500..ee20dd627 100644 --- a/libcob/common.h +++ b/libcob/common.h @@ -2392,6 +2392,13 @@ COB_EXPIMP int cob_get_scr_cols (void); COB_EXPIMP int cob_get_scr_lines (void); COB_EXPIMP int cob_sys_get_csr_pos (unsigned char *); COB_EXPIMP int cob_sys_set_csr_pos (unsigned char *); +COB_EXPIMP int cob_sys_open_vfile (unsigned char *, unsigned char *); +COB_EXPIMP int cob_sys_read_vfile (cob_u16_t, cob_u32_t, cob_u32_t, unsigned char*); +COB_EXPIMP int cob_sys_write_vfile (cob_u16_t, cob_u32_t, cob_u32_t, unsigned char*); +COB_EXPIMP int cob_sys_close_vfile (cob_u16_t); +COB_EXPIMP int cob_sys_open_vfile2 (unsigned char *, unsigned char *); +COB_EXPIMP int cob_sys_read_vfile2 (cob_u16_t, cob_u64_t, cob_u32_t, unsigned char*); +COB_EXPIMP int cob_sys_write_vfile2 (cob_u16_t, cob_u64_t, cob_u32_t, unsigned char*); /****************************************************************************** * * diff --git a/libcob/fileio.c b/libcob/fileio.c index 20c11e26b..7aca2d589 100644 --- a/libcob/fileio.c +++ b/libcob/fileio.c @@ -62,21 +62,53 @@ #define STDERR_FILENO fileno(stderr) #endif -/* Define some characters for checking LINE SEQUENTIAL data content */ -#define COB_CHAR_CR '\r' -#define COB_CHAR_FF '\f' -#define COB_CHAR_LF '\n' -#define COB_CHAR_SPC ' ' -#define COB_CHAR_TAB '\t' -#ifdef COB_EBCDIC_MACHINE -#define COB_CHAR_BS 0x16 -#define COB_CHAR_ESC 0x27 -#define COB_CHAR_SI 0x0F -#else -#define COB_CHAR_BS 0x08 -#define COB_CHAR_ESC 0x1B -#define COB_CHAR_SI 0x0F -#endif +/* heap definitions */ + + +/* heap error codes */ + +#define MAX_HEAPS_EXCEEDED 41 +#define INSUFFICIENT_MEMORY 42 +#define ERROR_OUT_OF_DATA_RANGE 44 /* Note: we may drop this as it isn't compatible to MF/Fuji */ +#define HEAP_OUT_BOUNDS 45 + +/* note that the _SEG_HDR structure is actually just the header of the segment, + the segment data is located after the header, is addressed via a void pointer */ + + #define EYE_BALL_SIZE 8 + + typedef struct _SEG_HDR + { + #ifdef _DEBUG + char eye_ball[EYE_BALL_SIZE]; + #endif + struct _SEG_HDR *ptr_prev_seg; + struct _SEG_HDR *ptr_next_seg; + cob_u32_t seg_data_size; + cob_u64_t seg_data_rel_start; + cob_u64_t seg_data_rel_end; + }SEG_HDR, *PSEG_HDR; + + typedef struct _HEAP_ENTRY + { + #ifdef _DEBUG + char eye_ball[EYE_BALL_SIZE]; + #endif + unsigned int alloc_size; + cob_u16_t heap_id; + PSEG_HDR ptr_seg_first; + PSEG_HDR ptr_seg_last; + cob_u32_t seg_count; + cob_u64_t total_alloc; + cob_u64_t total_data_alloc; + }HEAP_ENTRY, *PHEAP_ENTRY; + + /* TODO: make heap_array dynamic */ + #define MAX_HEAP 512 + /* list of available heaps for VFILE routines, + note that these are explicit not thread-local + but static over all threads */ + static HEAP_ENTRY heap_array[MAX_HEAP] = { 0 }; /* Define some characters for checking LINE SEQUENTIAL data content */ #define COB_CHAR_CR '\r' @@ -10094,3 +10126,347 @@ cob_path_to_absolute (const char *path) } return abs_path; } + +/* ============================================ */ +/* heap functions */ +/* ============================================ */ + + +static int +create_first_segment (PHEAP_ENTRY ptr_heap) +{ + const unsigned int data_size = ptr_heap->alloc_size - sizeof(SEG_HDR); + PSEG_HDR ptr_seg = cob_fast_malloc (ptr_heap->alloc_size); + + if (ptr_seg == NULL) { + return INSUFFICIENT_MEMORY; + } + +/* ====> first populate HEAP_ENTRY */ + + ptr_heap->ptr_seg_first = ptr_seg; + ptr_heap->ptr_seg_last = ptr_seg; + ptr_heap->seg_count = 1; + ptr_heap->total_alloc = ptr_heap->alloc_size; + ptr_heap->total_data_alloc = data_size; + +/* ====> next populate SEG header info */ + + #ifdef _DEBUG + memcpy ((void *)&ptr_seg->eye_ball ,"SEGMENT ", EYE_BALL_SIZE); + #endif + ptr_seg->ptr_prev_seg = NULL; + ptr_seg->ptr_next_seg = NULL; + ptr_seg->seg_data_rel_start = 0; + ptr_seg->seg_data_rel_end = data_size; + + return 0; +} + +/* CBL_OPEN_VFILE */ +static int +open_vfile (cob_u16_ptr heap_id, unsigned char status[2], const int gc_ext) +{ + PHEAP_ENTRY ptr_heap; + cob_u16_t heap; + + int return_code; + + if (cobglobptr->cob_call_params < 2 + || !COB_MODULE_PTR->cob_procedure_params[0] + || !COB_MODULE_PTR->cob_procedure_params[1] + || COB_MODULE_PTR->cob_procedure_params[0]->size != sizeof(cob_u16_t) + || COB_MODULE_PTR->cob_procedure_params[1]->size != 2) { + cob_set_exception (COB_EC_PROGRAM_ARG_MISMATCH); + return 1; + } + +/* if first vfile open then initial heap_array */ + + if (heap_array[0].heap_id == 0) { + ptr_heap = &heap_array[0]; + for (heap = 0; heap < MAX_HEAP; heap++, ptr_heap++) { + #ifdef _DEBUG + memcpy ((void *)&ptr_heap->eye_ball ,"HEAP ENT", EYE_BALL_SIZE); + #endif + ptr_heap->heap_id = heap + 1; + ptr_heap->ptr_seg_first = NULL; + ptr_heap->ptr_seg_last = NULL; + ptr_heap->seg_count = 0; + ptr_heap->total_alloc = 0; + ptr_heap->total_data_alloc = 0; + } + } + +/* find next available heap id */ + + ptr_heap = &heap_array[0]; + for (heap = 0; + heap < MAX_HEAP && ptr_heap->ptr_seg_first != NULL; + ptr_heap++, heap++) + { + } + + if (heap == MAX_HEAP) { + memcpy (status, "99", 2); + return MAX_HEAPS_EXCEEDED; + } + + *heap_id = heap + 1; + ptr_heap->alloc_size = gc_ext ? cobsetptr->cob_heap_memory_64 : cobsetptr->cob_heap_memory; + + return_code = create_first_segment (ptr_heap); + if (return_code == 0) { + memcpy (status, "00", 2); + } else { + memcpy (status, "99", 2); + } + + return return_code; +} + +/* CBL_OPEN_VFILE */ +int +cob_sys_open_vfile (unsigned char *heap_id, unsigned char *status) +{ + COB_CHK_PARMS (CBL_OPEN_VFILE, 2); + + return open_vfile ((cob_u16_ptr)heap_id, status, 0); +} + +/* CBL_OPEN_VFILE64 */ +int +cob_sys_open_vfile2 (unsigned char *heap_id, unsigned char *status) +{ + COB_CHK_PARMS (CBL_GC_OPEN_VFILE64, 2); + + return open_vfile ((cob_u16_ptr)heap_id, status, 1); +} + +static int +get_new_segment (PHEAP_ENTRY ptr_heap, PSEG_HDR ptr_seg_curr) +{ + const unsigned int data_size = ptr_heap->alloc_size - sizeof(SEG_HDR); + PSEG_HDR ptr_seg = cob_fast_malloc (ptr_heap->alloc_size); + + if (ptr_seg == NULL) { + return INSUFFICIENT_MEMORY; + } + +/* ====> first populate HEAP_ENTRY */ + + ptr_heap->ptr_seg_last = ptr_seg; + ptr_heap->seg_count++; + ptr_heap->total_alloc = ptr_heap->alloc_size * ptr_heap->seg_count; + ptr_heap->total_data_alloc = data_size * ptr_heap->seg_count; + +/* ====> next populate new SEG header info */ + + #ifdef _DEBUG + memcpy ((void *)&ptr_seg->eye_ball, "SEGMENT ", EYE_BALL_SIZE); + #endif + ptr_seg->ptr_prev_seg = ptr_seg_curr; + ptr_seg->ptr_next_seg = NULL; + ptr_seg->seg_data_rel_start = ptr_seg_curr->seg_data_rel_end; + ptr_seg->seg_data_rel_end = ptr_seg_curr->seg_data_rel_end + data_size; + + /* ====> next populate curr SEG header info */ + ptr_seg_curr->ptr_next_seg = ptr_seg; + + return 0; +} + +static int +locate_segment (cob_u16_t heap, cob_u64_t data_loc, cob_u32_t size, void *data_buffer, const int for_read) +{ + void *ptr_data; + void *ptr_buffer; + cob_u32_t move_len; + cob_u64_t offset; + cob_u64_t data_middle; + PHEAP_ENTRY ptr_heap; + PSEG_HDR ptr_seg; + + if (cobglobptr->cob_call_params < 4 + || !COB_MODULE_PTR->cob_procedure_params[3] + || COB_MODULE_PTR->cob_procedure_params[3]->size < size) { + cob_set_exception (COB_EC_PROGRAM_ARG_MISMATCH); + return 1; + } + +/* =====> first locate HEAP_ENTRY */ + + if (heap > MAX_HEAP || heap == 0 + || heap_array[heap - 1].heap_id == 0) { + cob_runtime_warning ("heap out of bounds %u", heap); + return HEAP_OUT_BOUNDS; + } + + ptr_heap = &heap_array[heap - 1]; + + /* verify that we actually initialized that heap */ + if (!ptr_heap->ptr_seg_first) { + return HEAP_OUT_BOUNDS; + } + + + /* don't read after the data we already wrote - note is writtn */ + if (for_read + && data_loc + size > ptr_heap->total_data_alloc) { + return ERROR_OUT_OF_DATA_RANGE; + } + + move_len = size; + ptr_buffer = data_buffer; +/* =====> next check to see if the search should be from the + front of the linked list or the end of it */ + + data_middle = ptr_heap->total_data_alloc>>2; + + if (data_loc < data_middle) { + ptr_seg = ptr_heap->ptr_seg_first; + } else { + ptr_seg = ptr_heap->ptr_seg_last; + } + +/* =====> find the first segment with a matching range + on the data_loc */ + + while ((data_loc < ptr_seg->seg_data_rel_start) + || (data_loc > ptr_seg->seg_data_rel_end)) + { + if (data_loc < ptr_seg->seg_data_rel_start) { + ptr_seg = ptr_seg->ptr_prev_seg; + /* LCOV_EXCL_START */ + if (!ptr_seg) { + cob_runtime_error (_("invalid internal call of %s"), __FUNCTION__); + cob_hard_failure_internal ("libcob"); + } + /* LCOV_EXCL_STOP */ + } else if (data_loc > ptr_seg->seg_data_rel_end) { + ptr_seg = ptr_seg->ptr_next_seg; + if (!ptr_seg) { + int return_code = get_new_segment (ptr_heap, ptr_seg); + if (return_code != 0) { + return return_code; + } + ptr_seg = ptr_heap->ptr_seg_last; + } + } + } + +/* ====> FIND THE OFFSET IN THE CURRENT DATA AREA */ + + ptr_data = (char*)ptr_seg + sizeof(SEG_HDR); + offset = data_loc - ptr_seg->seg_data_rel_start; + + /* CHECKME: this validation leads to the while-loop being executed + exactly one or two times; either drop it (and test that), + or unroll the loop */ + if (offset > ptr_heap->alloc_size - sizeof(SEG_HDR)) { + return ERROR_OUT_OF_DATA_RANGE; + } + +/* ====> NOW START MOVING THE DATA EITHER IN OR OUT */ + + while (move_len > 0) + { + const cob_u64_t data_remain = ptr_heap->alloc_size - sizeof(SEG_HDR) - offset; + ptr_data = (char*)ptr_data + offset; + if (data_remain >= move_len) { + if (for_read) { + memcpy (ptr_buffer, ptr_data, move_len); + } else { + memcpy (ptr_data, ptr_buffer, move_len); + } + move_len = 0; + } else { + if (for_read) { + memcpy (ptr_buffer, ptr_data, data_remain); + } else { + memcpy (ptr_data, ptr_buffer, data_remain); + } + move_len = move_len - data_remain; + if (ptr_seg->ptr_next_seg != NULL) { + ptr_seg = ptr_seg->ptr_next_seg; + } else { + int return_code = get_new_segment (ptr_heap, ptr_seg); + if (return_code != 0) { + return return_code; + } + ptr_seg = ptr_seg->ptr_next_seg; + } + offset = 0; + ptr_buffer = (char*)ptr_buffer + data_remain; + ptr_data = ptr_seg; + ptr_data = (char*)ptr_data + sizeof(SEG_HDR); + } + } + + return 0; +} + +int +cob_sys_read_vfile (cob_u16_t heap, cob_u32_t offset, cob_u32_t size, unsigned char *data) +{ + COB_CHK_PARMS (CBL_READ_VFILE, 4); + return locate_segment (heap, offset, size, data, 1); +} + + +int +cob_sys_write_vfile (cob_u16_t heap, cob_u32_t offset, cob_u32_t size, unsigned char *data) +{ + COB_CHK_PARMS (CBL_WRITE_VFILE, 4); + return locate_segment (heap, offset, size, data, 0); +} + +int +cob_sys_read_vfile2 (cob_u16_t heap, cob_u64_t offset, cob_u32_t size, unsigned char *data) +{ + COB_CHK_PARMS (CBL_GC_READ_VFILE64, 4); + return locate_segment (heap, offset, size, data, 1); +} + + +int +cob_sys_write_vfile2 (cob_u16_t heap, cob_u64_t offset, cob_u32_t size, unsigned char *data) +{ + COB_CHK_PARMS (CBL_GC_WRITE_VFILE64, 4); + return locate_segment (heap, offset, size, data, 0); +} + + +int +cob_sys_close_vfile (const cob_u16_t heap) +{ + PHEAP_ENTRY ptr_heap; + PSEG_HDR ptr_seg; + + COB_CHK_PARMS (CBL_CLOSE_VFILE, 1); + + if (heap > MAX_HEAP || heap == 0 + || heap_array[heap - 1].heap_id == 0) { + return HEAP_OUT_BOUNDS; + } + + ptr_heap = &heap_array[heap - 1]; + ptr_seg = ptr_heap->ptr_seg_first; + + while (ptr_seg != NULL) + { + PSEG_HDR ptr_seg_delete = ptr_seg; + ptr_seg = ptr_seg->ptr_next_seg; + free (ptr_seg_delete); + } + + ptr_heap->ptr_seg_first = NULL; + ptr_heap->ptr_seg_last = NULL; + ptr_heap->seg_count = 0; + ptr_heap->total_alloc = 0; + ptr_heap->total_data_alloc = 0; + + return 0; +} + +/* End of heap functions */ diff --git a/libcob/system.def b/libcob/system.def index 75d8742b9..a3491c852 100644 --- a/libcob/system.def +++ b/libcob/system.def @@ -1,5 +1,5 @@ /* - Copyright (C) 2006-2012, 2014, 2016-2019, 2022-2024 Free Software Foundation, Inc. + Copyright (C) 2006-2012, 2014, 2016-2019, 2022-2025 Free Software Foundation, Inc. Written by Roger While, Simon Sobisch, Ron Norman This file is part of GnuCOBOL. @@ -56,6 +56,10 @@ COB_SYSTEM_GEN ("CBL_TOLOWER", 2, 2, cob_sys_tolower) COB_SYSTEM_GEN ("CBL_TOUPPER", 2, 2, cob_sys_toupper) COB_SYSTEM_GEN ("CBL_WRITE_FILE", 5, 5, cob_sys_write_file) COB_SYSTEM_GEN ("CBL_XOR", 3, 3, cob_sys_xor) +COB_SYSTEM_GEN ("CBL_OPEN_VFILE", 2, 2, cob_sys_open_vfile) +COB_SYSTEM_GEN ("CBL_READ_VFILE", 4, 4, cob_sys_read_vfile) +COB_SYSTEM_GEN ("CBL_WRITE_VFILE", 4, 4, cob_sys_write_vfile) +COB_SYSTEM_GEN ("CBL_CLOSE_VFILE", 1, 1, cob_sys_close_vfile) COB_SYSTEM_GEN ("CBL_GC_FORK", 0, 0, cob_sys_fork) COB_SYSTEM_GEN ("CBL_GC_GETOPT", 6, 6, cob_sys_getopt_long_long) @@ -70,6 +74,10 @@ COB_SYSTEM_GEN ("CBL_OC_NANOSLEEP", 1, 1, cob_sys_oc_nanosleep) COB_SYSTEM_GEN ("CBL_GC_SCR_DUMP", 1, 1, cob_sys_scr_dump) COB_SYSTEM_GEN ("CBL_GC_SCR_RESTORE", 1, 1, cob_sys_scr_restore) COB_SYSTEM_GEN ("CBL_GC_WINDOW", 2, 2, cob_sys_window) +COB_SYSTEM_GEN ("CBL_GC_OPEN_VFILE64", 2, 2, cob_sys_open_vfile2) +COB_SYSTEM_GEN ("CBL_GC_READ_VFILE64", 4, 4, cob_sys_read_vfile2) +COB_SYSTEM_GEN ("CBL_GC_WRITE_VFILE64", 4, 4, cob_sys_write_vfile2) +COB_SYSTEM_GEN ("CBL_GC_CLOSE_VFILE64", 1, 1, cob_sys_close_vfile) COB_SYSTEM_GEN ("C$CALLEDBY", 1, 1, cob_sys_calledby) COB_SYSTEM_GEN ("C$CHDIR", 2, 2, cob_sys_chdir) COB_SYSTEM_GEN ("C$COPY", 3, 3, cob_sys_copyfile) diff --git a/tests/testsuite.src/run_file.at b/tests/testsuite.src/run_file.at index a135f4907..1a0114c78 100644 --- a/tests/testsuite.src/run_file.at +++ b/tests/testsuite.src/run_file.at @@ -1,4 +1,4 @@ -## Copyright (C) 2003-2012, 2014-2024 Free Software Foundation, Inc. +## Copyright (C) 2003-2012, 2014-2025 Free Software Foundation, Inc. ## Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman, ## Brian Tiffin, Joe Robbins, Edward Hart ## @@ -5582,6 +5582,982 @@ AT_CHECK([$COBCRUN_DIRECT ./prog sub/../prog.cob], [0], AT_CLEANUP +AT_SETUP([VFILE system routines]) +AT_KEYWORDS([extensions runfile virtual heap +CBL_OPEN_VFILE CBL_WRITE_VFILE CBL_READ_VFILE CBL_CLOSE_VFILE]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. VTEST005. + *AUTHOR. CHUCK HAATVEDT + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + + *SOURCE-COMPUTER. IBM-PC WITH DEBUGGING MODE. + + OBJECT-COMPUTER. IBM-PC. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + DATA DIVISION. + WORKING-STORAGE SECTION. + + 01 HEAP-ID PIC 9(4) COMP-5. + 01 RELATIVE-ADDRESS-IN-HEAP PIC S9(9) COMP-5. + 01 DATA-LENGTH PIC S9(9) COMP-5. + 01 HEAP-STATUS PIC X(2). + 01 STATUS-CODE PIC S9(4) COMP-5. + + 01 PTR-HEAP USAGE POINTER. + + 01 CNTR-COUNTERS. + 05 CNTR-HEAP PIC S9(9) COMP-5. + 05 CNTR-RCD-WRITTEN PIC S9(9) COMP-5. + 05 CNTR-RCD-READ PIC S9(9) COMP-5. + 05 CNTR-RCD-LENGTH PIC S9(9) COMP-5. + 05 CNTR-RELATVIE-POS PIC S9(9) COMP-5. + + 01 TIME-START. + 05 TS-HH PIC 99. + 05 TS-MM PIC 99. + 05 TS-SS PIC 99. + 05 TS-MS PIC 9(6). + + 01 TIME-WRITE. + 05 TW-HH PIC 99. + 05 TW-MM PIC 99. + 05 TW-SS PIC 99. + 05 TW-MS PIC 9(6). + + 01 TIME-READ. + 05 TR-HH PIC 99. + 05 TR-MM PIC 99. + 05 TR-SS PIC 99. + 05 TR-MS PIC 9(6). + + 01 TMP. + 05 TMP-DOUBLE PIC S9(18) COMP-5. + 05 TMP-MILLISECONDS PIC S9(9) COMP-5. + 05 TMP-NBR PIC S9(9) COMP-5. + 05 TMP-KB PIC X(8). + 05 TMP-DISPLAY PIC ZZZ,ZZZ,ZZ9. + 05 TMP-DISPLAY-LONG PIC ZZZ,ZZZ,ZZZ,ZZZ,ZZZ,ZZ9. + + 01 REC-BUFFER PIC X(100). + + 01 REC-RECORD-AREA. + 05 FILLER PIC X(7) VALUE 'HEAPID '. + 05 REC-HEAP-ID PIC 9(3). + 05 FILLER PIC X(8) VALUE ' RECORD '. + 05 REC-RCD-COUNT PIC ZZZ,ZZZ,ZZ9. + 05 FILLER PIC X VALUE SPACE. + 05 FILLER PIC X(10) + VALUE '0123456789'. + 05 FILLER PIC X(10) + VALUE '0123456789'. + 05 FILLER PIC X(10) + VALUE '0123456789'. + 05 FILLER PIC X(10) + VALUE '0123456789'. + 05 FILLER PIC X(10) + VALUE '0123456789'. + 05 FILLER PIC X(10) + VALUE '0123456789'. + 05 FILLER PIC X(10) + VALUE '0123456789'. + + + 01 ENV-TEXT PIC X(256). + + PROCEDURE DIVISION. + + 0000-MAINLINE. + + DISPLAY 'COB_HEAP_MEMORY' UPON ENVIRONMENT-NAME. + DISPLAY '16K' UPON ENVIRONMENT-VALUE. + + DISPLAY 'COB_HEAP_MEMORY_64' UPON ENVIRONMENT-NAME. + DISPLAY '256K' UPON ENVIRONMENT-VALUE. + + MOVE ZERO TO CNTR-HEAP. + MOVE LENGTH OF REC-RECORD-AREA + TO DATA-LENGTH. + D DISPLAY ' LENGTH OF DATA RECORD IS ' DATA-LENGTH. + + D ACCEPT TIME-START FROM MICROSECOND-TIME. + + PERFORM WITH TEST AFTER + UNTIL CNTR-HEAP >= 1 + OR RETURN-CODE NOT EQUAL ZERO + ADD +1 TO CNTR-HEAP + PERFORM 2000-OPEN-VFILE THRU 2000-EXIT + END-PERFORM. + + MOVE ZERO TO CNTR-RCD-WRITTEN. + + PERFORM 100000 TIMES + ADD +1 TO CNTR-RCD-WRITTEN + D IF CNTR-RCD-WRITTEN = 1311 + D CONTINUE + D END-IF + PERFORM 4000-WRITE-VFILE THRU 4000-EXIT + END-PERFORM. + + D ACCEPT TIME-WRITE FROM MICROSECOND-TIME. + + MOVE ZERO TO CNTR-RCD-READ. + + PERFORM 100000 TIMES + ADD +1 TO CNTR-RCD-READ + PERFORM 5000-READ-VFILE THRU 5000-EXIT + END-PERFORM. + + D ACCEPT TIME-READ FROM MICROSECOND-TIME. + + D DISPLAY 'THIS IS THE TIME USED TO READ ' + D 'AND WRITE 5,000,000 ' + D DATA-LENGTH ' BYTE SIZE'. + D + D DISPLAY 'START TIME IS ==> ' + D TS-HH ':' + D TS-MM ':' + D TS-SS ':' + D TS-MS. + D + D DISPLAY 'WRITE TIME IS ==> ' + D TW-HH ':' + D TW-MM ':' + D TW-SS ':' + D TW-MS. + D + D DISPLAY ' READ TIME IS ==> ' + D TR-HH ':' + D TR-MM ':' + D TR-SS ':' + D TR-MS. + + 0000-STOP. + + GOBACK. + + 0000-EXIT. EXIT. + + 2000-OPEN-VFILE. + + CALL 'CBL_OPEN_VFILE' + USING BY REFERENCE HEAP-ID + BY REFERENCE HEAP-STATUS. + + IF RETURN-CODE NOT EQUAL ZERO + DISPLAY 'CBL_OPEN_VFILE FAILED AT HEAP-ID ==> ' + CNTR-HEAP. + + D DISPLAY ' HEAP-ID IS ==> ' HEAP-ID. + + 2000-EXIT. EXIT. + 4000-WRITE-VFILE. + + * IF CNTR-RCD-WRITTEN = 11 + * COMPUTE RELATIVE-ADDRESS-IN-HEAP + * = ((5 - 1) * DATA-LENGTH) + * END-COMPUTE + * ELSE + COMPUTE RELATIVE-ADDRESS-IN-HEAP + = ((CNTR-RCD-WRITTEN - 1) * DATA-LENGTH) + END-COMPUTE + * END-IF. + MOVE SPACES TO HEAP-STATUS + MOVE HEAP-ID TO REC-HEAP-ID + MOVE CNTR-RCD-WRITTEN TO REC-RCD-COUNT + + D DISPLAY ' '. + D DISPLAY 'CNTR-RCD-WRITTEN IS ' + D CNTR-RCD-WRITTEN + D DISPLAY 'RECORD WRITTEN AT OFFSET ' + D RELATIVE-ADDRESS-IN-HEAP + D DISPLAY 'DATA LENGTH IS ' + D DATA-LENGTH + D DISPLAY REC-RECORD-AREA (1:50). + D DISPLAY ' '. + + * IF CNTR-RCD-WRITTEN >= 1305 + * AND CNTR-RCD-WRITTEN <= 1329 + * DISPLAY ' IN CBL_WRITE_VFILE ' + * 'HEAP ID ' HEAP-ID + * ' REL ADDR ' RELATIVE-ADDRESS-IN-HEAP + * ' DATA LEN ' DATA-LENGTH + * END-IF. + + CALL "CBL_WRITE_VFILE" + USING BY VALUE HEAP-ID + BY VALUE RELATIVE-ADDRESS-IN-HEAP + BY VALUE DATA-LENGTH + BY REFERENCE REC-RECORD-AREA. + + IF RETURN-CODE NOT EQUAL ZERO + DISPLAY 'CBL_WRITE_VFILE BAD RETURN CODE ' + RETURN-CODE + ' AT RCD ' + CNTR-RCD-WRITTEN + GO TO 0000-STOP + END-IF. + + 4000-EXIT. EXIT. + + + 5000-READ-VFILE. + + COMPUTE RELATIVE-ADDRESS-IN-HEAP + = ((CNTR-RCD-READ - 1) * DATA-LENGTH) + END-COMPUTE. + + MOVE SPACES TO HEAP-STATUS. + MOVE HEAP-ID TO REC-HEAP-ID. + MOVE CNTR-RCD-READ TO REC-RCD-COUNT. + + CALL "CBL_READ_VFILE" + USING BY VALUE HEAP-ID + BY VALUE RELATIVE-ADDRESS-IN-HEAP + BY VALUE DATA-LENGTH + BY REFERENCE REC-BUFFER. + + IF RETURN-CODE NOT EQUAL ZERO + DISPLAY 'CBL_READ_VFILE BAD RETURN CODE ' + RETURN-CODE + ' AT RCD ' + CNTR-RCD-READ + GO TO 0000-STOP + END-IF. + + IF REC-RECORD-AREA NOT EQUAL REC-BUFFER + DISPLAY ' ' + DISPLAY ' CORRUPT RECORD AT ' CNTR-RCD-READ + DISPLAY 'COMPARE RECORD .... THEN REC-BUFFER IN HEX' + DISPLAY '-------------------' + DISPLAY REC-RECORD-AREA (1:50) + DISPLAY '-------------------' + DISPLAY REC-BUFFER (1:50) + DISPLAY 'HEX OF ' + FUNCTION HEX-OF (REC-BUFFER (1:50)) + DISPLAY 'HEX OF ' + FUNCTION HEX-OF (REC-BUFFER (51:50)) + DISPLAY '-------------------' + DISPLAY ' ' + * GO TO 0000-STOP + END-IF. + + 5000-EXIT. EXIT. + + + 6000-CLOSE-VFILE-ALL. + + MOVE ZERO TO HEAP-ID. + + PERFORM 512 TIMES + ADD +1 TO HEAP-ID + CALL 'CBL_CLOSE_VFILE' + USING BY VALUE HEAP-ID + IF RETURN-CODE NOT EQUAL ZERO + DISPLAY 'CBL_CLOSE_VFILE BAD RETURN CODE ' + RETURN-CODE + ' AT HEAP ID ' + HEAP-ID + GO TO 0000-STOP + END-IF + END-PERFORM. + + 6000-EXIT. EXIT. + + + END PROGRAM VTEST005. +]) + +AT_CHECK([$COMPILE prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([VFILE system routines, GC extension]) +AT_KEYWORDS([extensions runfile virtual heap +CBL_GC_OPEN_VFILE CBL_GC_WRITE_VFILE CBL_GC_READ_VFILE CBL_GC_CLOSE_VFILE]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. VTEST006. + *AUTHOR. CHUCK HAATVEDT + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + + *SOURCE-COMPUTER. IBM-PC WITH DEBUGGING MODE. + + OBJECT-COMPUTER. IBM-PC. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + DATA DIVISION. + WORKING-STORAGE SECTION. + + 01 HEAP-ID PIC 9(4) COMP-5. + 01 RELATIVE-ADDRESS-IN-HEAP PIC S9(18) COMP-5. + 01 DATA-LENGTH PIC S9(9) COMP-5. + 01 HEAP-STATUS PIC X(2). + 01 STATUS-CODE PIC S9(4) COMP-5. + + 01 PTR-HEAP USAGE POINTER. + + 01 CNTR-COUNTERS. + 05 CNTR-HEAP PIC S9(9) COMP-5. + 05 CNTR-RCD-WRITTEN PIC S9(9) COMP-5. + 05 CNTR-RCD-READ PIC S9(9) COMP-5. + 05 CNTR-RCD-LENGTH PIC S9(9) COMP-5. + 05 CNTR-RELATVIE-POS PIC S9(9) COMP-5. + + 01 TIME-START. + 05 TS-HH PIC 99. + 05 TS-MM PIC 99. + 05 TS-SS PIC 99. + 05 TS-MS PIC 9(6). + + 01 TIME-WRITE. + 05 TW-HH PIC 99. + 05 TW-MM PIC 99. + 05 TW-SS PIC 99. + 05 TW-MS PIC 9(6). + + 01 TIME-READ. + 05 TR-HH PIC 99. + 05 TR-MM PIC 99. + 05 TR-SS PIC 99. + 05 TR-MS PIC 9(6). + + 01 TMP. + 05 TMP-DOUBLE PIC S9(18) COMP-5. + 05 TMP-MILLISECONDS PIC S9(9) COMP-5. + 05 TMP-NBR PIC S9(9) COMP-5. + 05 TMP-KB PIC X(8). + 05 TMP-DISPLAY PIC ZZZ,ZZZ,ZZ9. + 05 TMP-DISPLAY-LONG PIC ZZZ,ZZZ,ZZZ,ZZZ,ZZZ,ZZ9. + + 01 REC-BUFFER PIC X(1000). + + 01 REC-RECORD-AREA. + 05 FILLER PIC X(7) VALUE 'HEAPID '. + 05 REC-HEAP-ID PIC 9(3). + 05 FILLER PIC X(8) VALUE ' RECORD '. + 05 REC-RCD-COUNT PIC ZZZ,ZZZ,ZZ9. + 05 FILLER PIC X VALUE SPACE. + 05 FILLER PIC X(10) + VALUE '0123456789'. + 05 FILLER PIC X(10) + VALUE '0123456789'. + 05 FILLER PIC X(10) + VALUE '0123456789'. + 05 FILLER PIC X(10) + VALUE '0123456789'. + 05 FILLER PIC X(10) + VALUE '0123456789'. + 05 FILLER PIC X(10) + VALUE '0123456789'. + 05 FILLER PIC X(10) + VALUE '0123456789'. + 05 FILLER PIC X(900) + VALUE LOW-VALUES. + + + 01 ENV-TEXT PIC X(256). + + PROCEDURE DIVISION. + + 0000-MAINLINE. + + DISPLAY 'COB_HEAP_MEMORY' UPON ENVIRONMENT-NAME. + DISPLAY '16K' UPON ENVIRONMENT-VALUE. + + DISPLAY 'COB_HEAP_MEMORY_64' UPON ENVIRONMENT-NAME. + DISPLAY '256K' UPON ENVIRONMENT-VALUE. + + MOVE ZERO TO CNTR-HEAP. + MOVE LENGTH OF REC-RECORD-AREA + TO DATA-LENGTH. + D DISPLAY ' LENGTH OF DATA RECORD IS ' DATA-LENGTH. + + D ACCEPT TIME-START FROM MICROSECOND-TIME. + + PERFORM WITH TEST AFTER + UNTIL CNTR-HEAP >= 1 + OR RETURN-CODE NOT EQUAL ZERO + ADD +1 TO CNTR-HEAP + PERFORM 2000-OPEN-VFILE THRU 2000-EXIT + END-PERFORM. + + MOVE ZERO TO CNTR-RCD-WRITTEN. + + PERFORM 100000 TIMES + ADD +1 TO CNTR-RCD-WRITTEN + D IF CNTR-RCD-WRITTEN = 1311 + D CONTINUE + D END-IF + PERFORM 4000-WRITE-VFILE THRU 4000-EXIT + END-PERFORM. + + D ACCEPT TIME-WRITE FROM MICROSECOND-TIME. + + MOVE ZERO TO CNTR-RCD-READ. + + PERFORM 100000 TIMES + ADD +1 TO CNTR-RCD-READ + PERFORM 5000-READ-VFILE THRU 5000-EXIT + END-PERFORM. + + D ACCEPT TIME-READ FROM MICROSECOND-TIME. + + D DISPLAY 'THIS IS THE TIME USED TO READ ' + D 'AND WRITE 5,000,000 ' + D DATA-LENGTH ' BYTE SIZE'. + D + D DISPLAY 'START TIME IS ==> ' + D TS-HH ':' + D TS-MM ':' + D TS-SS ':' + D TS-MS. + D + D DISPLAY 'WRITE TIME IS ==> ' + D TW-HH ':' + D TW-MM ':' + D TW-SS ':' + D TW-MS. + D + D DISPLAY ' READ TIME IS ==> ' + D TR-HH ':' + D TR-MM ':' + D TR-SS ':' + D TR-MS. + + 0000-STOP. + + GOBACK. + + 0000-EXIT. EXIT. + + 2000-OPEN-VFILE. + + CALL 'CBL_OPEN_VFILE' + USING BY REFERENCE HEAP-ID + BY REFERENCE HEAP-STATUS. + + IF RETURN-CODE NOT EQUAL ZERO + DISPLAY 'CBL_OPEN_VFILE FAILED AT HEAP-ID ==> ' + CNTR-HEAP. + + D DISPLAY ' HEAP-ID IS ==> ' HEAP-ID. + + 2000-EXIT. EXIT. + 4000-WRITE-VFILE. + + * IF CNTR-RCD-WRITTEN = 11 + * COMPUTE RELATIVE-ADDRESS-IN-HEAP + * = ((5 - 1) * DATA-LENGTH) + * END-COMPUTE + * ELSE + COMPUTE RELATIVE-ADDRESS-IN-HEAP + = ((CNTR-RCD-WRITTEN - 1) * DATA-LENGTH) + END-COMPUTE + * END-IF. + MOVE SPACES TO HEAP-STATUS + MOVE HEAP-ID TO REC-HEAP-ID + MOVE CNTR-RCD-WRITTEN TO REC-RCD-COUNT + + D DISPLAY ' '. + D DISPLAY 'CNTR-RCD-WRITTEN IS ' + D CNTR-RCD-WRITTEN + D DISPLAY 'RECORD WRITTEN AT OFFSET ' + D RELATIVE-ADDRESS-IN-HEAP + D DISPLAY 'DATA LENGTH IS ' + D DATA-LENGTH + D DISPLAY REC-RECORD-AREA (1:50). + D DISPLAY ' '. + + * IF CNTR-RCD-WRITTEN >= 1305 + * AND CNTR-RCD-WRITTEN <= 1329 + * DISPLAY ' IN CBL_WRITE_VFILE ' + * 'HEAP ID ' HEAP-ID + * ' REL ADDR ' RELATIVE-ADDRESS-IN-HEAP + * ' DATA LEN ' DATA-LENGTH + * END-IF. + + CALL "CBL_GC_WRITE_VFILE64" + USING BY VALUE HEAP-ID + BY VALUE RELATIVE-ADDRESS-IN-HEAP + BY VALUE DATA-LENGTH + BY REFERENCE REC-RECORD-AREA. + + IF RETURN-CODE NOT EQUAL ZERO + DISPLAY 'CBL_WRITE_VFILE BAD RETURN CODE ' + RETURN-CODE + ' AT RCD ' + CNTR-RCD-WRITTEN + GO TO 0000-STOP + END-IF. + + 4000-EXIT. EXIT. + + + 5000-READ-VFILE. + + COMPUTE RELATIVE-ADDRESS-IN-HEAP + = ((CNTR-RCD-READ - 1) * DATA-LENGTH) + END-COMPUTE. + + MOVE SPACES TO HEAP-STATUS. + MOVE HEAP-ID TO REC-HEAP-ID. + MOVE CNTR-RCD-READ TO REC-RCD-COUNT. + + CALL "CBL_GC_READ_VFILE64" + USING BY VALUE HEAP-ID + BY VALUE RELATIVE-ADDRESS-IN-HEAP + BY VALUE DATA-LENGTH + BY REFERENCE REC-BUFFER. + + IF RETURN-CODE NOT EQUAL ZERO + DISPLAY 'CBL_READ_VFILE BAD RETURN CODE ' + RETURN-CODE + ' AT RCD ' + CNTR-RCD-READ + GO TO 0000-STOP + END-IF. + + IF REC-RECORD-AREA (1:100) NOT EQUAL REC-BUFFER (1:100) + DISPLAY ' ' + DISPLAY ' CORRUPT RECORD AT ' CNTR-RCD-READ + DISPLAY 'COMPARE RECORD .... THEN REC-BUFFER IN HEX' + DISPLAY '-------------------' + DISPLAY REC-RECORD-AREA (1:50) + DISPLAY '-------------------' + DISPLAY REC-BUFFER (1:50) + DISPLAY 'HEX OF ' + FUNCTION HEX-OF (REC-BUFFER (1:50)) + DISPLAY 'HEX OF ' + FUNCTION HEX-OF (REC-BUFFER (51:50)) + DISPLAY '-------------------' + DISPLAY ' ' + * GO TO 0000-STOP + END-IF. + + 5000-EXIT. EXIT. + + + 6000-CLOSE-VFILE-ALL. + + MOVE ZERO TO HEAP-ID. + + PERFORM 512 TIMES + ADD +1 TO HEAP-ID + CALL 'CBL_CLOSE_VFILE' + USING BY VALUE HEAP-ID + IF RETURN-CODE NOT EQUAL ZERO + DISPLAY 'CBL_CLOSE_VFILE BAD RETURN CODE ' + RETURN-CODE + ' AT HEAP ID ' + HEAP-ID + GO TO 0000-STOP + END-IF + END-PERFORM. + + 6000-EXIT. EXIT. + + + END PROGRAM VTEST006. +]) + +AT_CHECK([$COMPILE prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([VFILE system routines, error handling]) +AT_KEYWORDS([extensions runfile virtual heap +CBL_OPEN_VFILE CBL_WRITE_VFILE CBL_READ_VFILE CBL_CLOSE_VFILE]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. VTEST007. + *AUTHOR. CHUCK HAATVEDT + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + + *SOURCE-COMPUTER. IBM-PC WITH DEBUGGING MODE. + + OBJECT-COMPUTER. IBM-PC. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + DATA DIVISION. + WORKING-STORAGE SECTION. + + * VFILE RETURN-CODE ERRORS + + 78 MAX-HEAPS-EXCEEDED VALUE 41. + 78 ERROR-OUT-OF-DATA-RANGE VALUE 44. + 78 HEAP-OUT-BOUNDS VALUE 45. + + 01 HEAP-ID PIC 9(4) COMP-5. + 01 RELATIVE-ADDRESS-IN-HEAP PIC S9(9) COMP-5. + 01 DATA-LENGTH PIC S9(9) COMP-5. + 01 HEAP-STATUS PIC X(2). + 01 STATUS-CODE PIC S9(4) COMP-5. + + 01 PTR-HEAP USAGE POINTER. + + 01 CNTR-COUNTERS. + 05 CNTR-HEAP PIC S9(9) COMP-5. + 05 CNTR-RCD-WRITTEN PIC S9(9) COMP-5. + 05 CNTR-RCD-READ PIC S9(9) COMP-5. + 05 CNTR-RCD-LENGTH PIC S9(9) COMP-5. + 05 CNTR-RELATVIE-POS PIC S9(9) COMP-5. + + 01 TIME-START. + 05 TS-HH PIC 99. + 05 TS-MM PIC 99. + 05 TS-SS PIC 99. + 05 TS-MS PIC 9(6). + + 01 TIME-WRITE. + 05 TW-HH PIC 99. + 05 TW-MM PIC 99. + 05 TW-SS PIC 99. + 05 TW-MS PIC 9(6). + + 01 TIME-READ. + 05 TR-HH PIC 99. + 05 TR-MM PIC 99. + 05 TR-SS PIC 99. + 05 TR-MS PIC 9(6). + + 01 TMP. + 05 TMP-DOUBLE PIC S9(18) COMP-5. + 05 TMP-MILLISECONDS PIC S9(9) COMP-5. + 05 TMP-NBR PIC S9(9) COMP-5. + 05 TMP-KB PIC X(8). + 05 TMP-DISPLAY PIC ZZZ,ZZZ,ZZ9. + 05 TMP-DISPLAY-LONG PIC ZZZ,ZZZ,ZZZ,ZZZ,ZZZ,ZZ9. + + 01 REC-BUFFER PIC X(100). + + 01 REC-RECORD-AREA. + 05 FILLER PIC X(7) VALUE 'HEAPID '. + 05 REC-HEAP-ID PIC 9(3). + 05 FILLER PIC X(8) VALUE ' RECORD '. + 05 REC-RCD-COUNT PIC ZZZ,ZZZ,ZZ9. + 05 FILLER PIC X VALUE SPACE. + 05 FILLER PIC X(10) + VALUE '0123456789'. + 05 FILLER PIC X(10) + VALUE '0123456789'. + 05 FILLER PIC X(10) + VALUE '0123456789'. + 05 FILLER PIC X(10) + VALUE '0123456789'. + 05 FILLER PIC X(10) + VALUE '0123456789'. + 05 FILLER PIC X(10) + VALUE '0123456789'. + 05 FILLER PIC X(10) + VALUE '0123456789'. + + + 01 ENV-TEXT PIC X(256). + + PROCEDURE DIVISION. + + 0000-MAINLINE. + + DISPLAY 'COB_HEAP_MEMORY' UPON ENVIRONMENT-NAME. + DISPLAY '16K' UPON ENVIRONMENT-VALUE. + + DISPLAY 'COB_HEAP_MEMORY_64' UPON ENVIRONMENT-NAME. + DISPLAY '256K' UPON ENVIRONMENT-VALUE. + + MOVE ZERO TO CNTR-HEAP. + MOVE LENGTH OF REC-RECORD-AREA + TO DATA-LENGTH. + D DISPLAY ' LENGTH OF DATA RECORD IS ' DATA-LENGTH. + + D ACCEPT TIME-START FROM MICROSECOND-TIME. + + PERFORM WITH TEST AFTER + UNTIL CNTR-HEAP >= 513 + OR RETURN-CODE NOT EQUAL ZERO + ADD +1 TO CNTR-HEAP + PERFORM 2000-OPEN-VFILE THRU 2000-EXIT + END-PERFORM. + + PERFORM 6000-CLOSE-VFILE-ALL THRU 6000-EXIT. + + MOVE +1 TO CNTR-RCD-WRITTEN. + MOVE 44 TO HEAP-ID. + + PERFORM 4000-WRITE-VFILE THRU 4000-EXIT + + MOVE +1 TO CNTR-RCD-WRITTEN. + MOVE 999 TO HEAP-ID. + + PERFORM 4000-WRITE-VFILE THRU 4000-EXIT + + MOVE +1 TO CNTR-HEAP. + PERFORM 2000-OPEN-VFILE THRU 2000-EXIT. + + MOVE ZERO TO CNTR-RCD-WRITTEN. + + PERFORM 10 TIMES + ADD +1 TO CNTR-RCD-WRITTEN + D IF CNTR-RCD-WRITTEN = 1311 + D CONTINUE + D END-IF + PERFORM 4000-WRITE-VFILE THRU 4000-EXIT + END-PERFORM. + + D ACCEPT TIME-WRITE FROM MICROSECOND-TIME. + + MOVE ZERO TO CNTR-RCD-READ. + + PERFORM 10 TIMES + ADD +1 TO CNTR-RCD-READ + PERFORM 5000-READ-VFILE THRU 5000-EXIT + END-PERFORM. + + MOVE 10000 TO CNTR-RCD-READ. + PERFORM 5000-READ-VFILE THRU 5000-EXIT + + PERFORM 6000-CLOSE-VFILE-ALL THRU 6000-EXIT. + + D ACCEPT TIME-READ FROM MICROSECOND-TIME. + + D DISPLAY 'THIS IS THE TIME USED TO READ ' + D 'AND WRITE 5,000,000 ' + D DATA-LENGTH ' BYTE SIZE'. + D + D DISPLAY 'START TIME IS ==> ' + D TS-HH ':' + D TS-MM ':' + D TS-SS ':' + D TS-MS. + D + D DISPLAY 'WRITE TIME IS ==> ' + D TW-HH ':' + D TW-MM ':' + D TW-SS ':' + D TW-MS. + D + D DISPLAY ' READ TIME IS ==> ' + D TR-HH ':' + D TR-MM ':' + D TR-SS ':' + D TR-MS. + + 0000-STOP. + + GOBACK. + + 0000-EXIT. EXIT. + + 2000-OPEN-VFILE. + + CALL 'CBL_OPEN_VFILE' + USING BY REFERENCE HEAP-ID + BY REFERENCE HEAP-STATUS. + + IF CNTR-HEAP > 512 + AND (RETURN-CODE NOT EQUAL MAX-HEAPS-EXCEEDED + OR HEAP-STATUS (1:1) EQUAL '0') + DISPLAY 'CBL_OPEN_VFILE FAILED AT HEAP-ID ==> ' + CNTR-HEAP + ' RETURN CODE IS --> ' + RETURN-CODE + ' HEAP-STATUS IS --> ' + HEAP-STATUS + END-IF. + + IF CNTR-HEAP <= 512 + AND (RETURN-CODE NOT EQUAL ZERO + OR HEAP-STATUS (1:1) NOT EQUAL '0') + DISPLAY 'CBL_OPEN_VFILE FAILED AT HEAP-ID ==> ' + CNTR-HEAP + ' RETURN CODE IS --> ' + RETURN-CODE + ' HEAP-STATUS IS --> ' + HEAP-STATUS + END-IF. + + D DISPLAY ' HEAP-ID IS ==> ' HEAP-ID. + + 2000-EXIT. EXIT. + + + 4000-WRITE-VFILE. + + * IF CNTR-RCD-WRITTEN = 11 + * COMPUTE RELATIVE-ADDRESS-IN-HEAP + * = ((5 - 1) * DATA-LENGTH) + * END-COMPUTE + * ELSE + COMPUTE RELATIVE-ADDRESS-IN-HEAP + = ((CNTR-RCD-WRITTEN - 1) * DATA-LENGTH) + END-COMPUTE + * END-IF. + MOVE SPACES TO HEAP-STATUS + MOVE HEAP-ID TO REC-HEAP-ID + MOVE CNTR-RCD-WRITTEN TO REC-RCD-COUNT + + D DISPLAY ' '. + D DISPLAY 'CNTR-RCD-WRITTEN IS ' + D CNTR-RCD-WRITTEN + D DISPLAY 'RECORD WRITTEN AT OFFSET ' + D RELATIVE-ADDRESS-IN-HEAP + D DISPLAY 'DATA LENGTH IS ' + D DATA-LENGTH + D DISPLAY REC-RECORD-AREA (1:50). + D DISPLAY ' '. + + * IF CNTR-RCD-WRITTEN >= 1305 + * AND CNTR-RCD-WRITTEN <= 1329 + * DISPLAY ' IN CBL_WRITE_VFILE ' + * 'HEAP ID ' HEAP-ID + * ' REL ADDR ' RELATIVE-ADDRESS-IN-HEAP + * ' DATA LEN ' DATA-LENGTH + * END-IF. + + CALL "CBL_WRITE_VFILE" + USING BY VALUE HEAP-ID + BY VALUE RELATIVE-ADDRESS-IN-HEAP + BY VALUE DATA-LENGTH + BY REFERENCE REC-RECORD-AREA. + + IF HEAP-ID EQUAL 999 + IF RETURN-CODE EQUAL HEAP-OUT-BOUNDS + GO TO 4000-EXIT + ELSE + DISPLAY 'CBL_WRITE_VFILE BAD RETURN CODE ' + RETURN-CODE + ' AT RCD ' + CNTR-RCD-WRITTEN + ' HEAP-ID ==> ' + HEAP-ID + D GO TO 0000-STOP + END-IF + END-IF. + + IF HEAP-ID EQUAL 44 + IF RETURN-CODE NOT EQUAL HEAP-OUT-BOUNDS + DISPLAY 'CBL_WRITE_VFILE BAD RETURN CODE ' + RETURN-CODE + ' AT RCD ' + CNTR-RCD-WRITTEN + ' HEAP-ID ==> ' + HEAP-ID + GO TO 0000-STOP + END-IF + ELSE + IF RETURN-CODE NOT EQUAL ZERO + DISPLAY 'CBL_WRITE_VFILE BAD RETURN CODE ' + RETURN-CODE + ' AT RCD ' + CNTR-RCD-WRITTEN + ' HEAP-ID ==> ' + HEAP-ID + D GO TO 00000-STOP + END-IF + END-IF. + + 4000-EXIT. EXIT. + + + 5000-READ-VFILE. + + COMPUTE RELATIVE-ADDRESS-IN-HEAP + = ((CNTR-RCD-READ - 1) * DATA-LENGTH) + END-COMPUTE. + + MOVE SPACES TO HEAP-STATUS. + MOVE HEAP-ID TO REC-HEAP-ID. + MOVE CNTR-RCD-READ TO REC-RCD-COUNT. + + CALL "CBL_READ_VFILE" + USING BY VALUE HEAP-ID + BY VALUE RELATIVE-ADDRESS-IN-HEAP + BY VALUE DATA-LENGTH + BY REFERENCE REC-BUFFER. + + IF CNTR-RCD-READ > 100 + *> Note: we may drop this as it isn't compatible to MF/Fuji + IF RETURN-CODE EQUAL ERROR-OUT-OF-DATA-RANGE + GO TO 5000-EXIT + ELSE + DISPLAY 'CBL_READ_VFILE BAD RETURN CODE ' + RETURN-CODE + ' AT RCD ' + CNTR-RCD-READ + GO TO 5000-EXIT + END-IF + ELSE + IF RETURN-CODE NOT EQUAL ZERO + DISPLAY 'CBL_READ_VFILE BAD RETURN CODE ' + RETURN-CODE + ' AT RCD ' + CNTR-RCD-READ + D GO TO 0000-STOP + END-IF + END-IF. + + IF REC-RECORD-AREA NOT EQUAL REC-BUFFER + DISPLAY ' ' + DISPLAY ' CORRUPT RECORD AT ' CNTR-RCD-READ + DISPLAY 'COMPARE RECORD .... THEN REC-BUFFER IN HEX' + DISPLAY '-------------------' + DISPLAY REC-RECORD-AREA (1:50) + DISPLAY '-------------------' + DISPLAY REC-BUFFER (1:50) + DISPLAY 'HEX OF ' + FUNCTION HEX-OF (REC-BUFFER (1:50)) + DISPLAY 'HEX OF ' + FUNCTION HEX-OF (REC-BUFFER (51:50)) + DISPLAY '-------------------' + DISPLAY ' ' + * GO TO 0000-STOP + END-IF. + + 5000-EXIT. EXIT. + + + 6000-CLOSE-VFILE-ALL. + + MOVE ZERO TO HEAP-ID. + + PERFORM 512 TIMES + ADD +1 TO HEAP-ID + CALL 'CBL_CLOSE_VFILE' + USING BY VALUE HEAP-ID + IF RETURN-CODE NOT EQUAL ZERO + DISPLAY 'CBL_CLOSE_VFILE BAD RETURN CODE ' + RETURN-CODE + ' AT HEAP ID ' + HEAP-ID + D GO TO 0000-STOP + END-IF + END-PERFORM. + + 6000-EXIT. EXIT. + + + END PROGRAM VTEST007. +]) + +AT_CHECK([$COMPILE prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], +[libcob: prog.cob:248: warning: heap out of bounds 999 +]) + +AT_CLEANUP + + AT_SETUP([System routine CBL_COPY_FILE]) AT_KEYWORDS([runfile extensions runfile]) diff --git a/tests/testsuite.src/run_fundamental.at b/tests/testsuite.src/run_fundamental.at index 2da3b1d56..7c24e0c0b 100644 --- a/tests/testsuite.src/run_fundamental.at +++ b/tests/testsuite.src/run_fundamental.at @@ -1,4 +1,4 @@ -## Copyright (C) 2003-2012, 2014-2015, 2017-2024 +## Copyright (C) 2003-2012, 2014-2015, 2017-2025 ## Free Software Foundation, Inc. ## Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, ## Ron Norman, Denis HUGONNARD-ROCHE, Chuck Haatvedt @@ -442,7 +442,7 @@ AT_DATA([prog.cob], [ ]) AT_CHECK([$COMPILE -Wno-truncate prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) AT_CLEANUP @@ -2120,7 +2120,7 @@ AT_DATA([prog.cob], [ ]) AT_CHECK([$COMPILE -Wno-truncate prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) AT_CLEANUP @@ -2425,7 +2425,7 @@ AT_DATA([prog.cob], [ ]) AT_CHECK([$COMPILE -Wno-truncate prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) AT_CLEANUP @@ -2505,7 +2505,7 @@ AT_CHECK([$COBCRUN_DIRECT ./prog], [0], > $456,789.00 < > -100< > -1,000< -]) +], []) AT_CLEANUP @@ -2577,7 +2577,7 @@ AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -4 3 -3 -]) +], []) AT_CLEANUP @@ -3631,7 +3631,7 @@ AT_DATA([prog.cob], [ ]) AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) AT_CLEANUP From a52cb23f196f5274e375458cf4c6a39d9ad38080 Mon Sep 17 00:00:00 2001 From: David Declerck Date: Thu, 31 Jul 2025 10:59:29 +0200 Subject: [PATCH 4/7] Merge 5549 --- cobc/ChangeLog | 5 +++++ cobc/cobc.h | 9 ++++++++- cobc/replace.c | 6 +++--- cobc/scanner.l | 4 ++-- cobc/tree.h | 15 ++++----------- tests/testsuite.src/run_misc.at | 6 +++--- 6 files changed, 25 insertions(+), 20 deletions(-) diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 7cf38c310..a3e735d83 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,4 +1,9 @@ +2025-07-15 Simon Sobisch + + * cobc.h, tree.h, replace.c, scanner.l: fixed enum and forward definitions + for C89 compat + 2025-06-02 Simon Sobisch * cobc.c (cobc_sig_handler) [!HAVE_SIGNAL_H]: fix compile error as diff --git a/cobc/cobc.h b/cobc/cobc.h index 30ead0134..5d6a140ef 100644 --- a/cobc/cobc.h +++ b/cobc/cobc.h @@ -82,7 +82,7 @@ enum cb_format { CB_FORMAT_ICOBOL_CRT, /* ICOBOL Free-form format (CRT) */ CB_FORMAT_ACUTERM, /* ACU Terminal format, named "TERMINAL" */ CB_FORMAT_COBOLX, /* GCOS's COBOLX */ - CB_FORMAT_AUTO, /* Auto-detect format */ + CB_FORMAT_AUTO /* Auto-detect format */ }; #define CB_SF_FREE(sf) (sf == CB_FORMAT_FREE) #define CB_SF_FIXED(sf) (sf == CB_FORMAT_FIXED || sf == CB_FORMAT_COBOL85) @@ -229,6 +229,13 @@ enum cb_screen_clauses_rules { CB_XOPEN_SCREEN_RULES }; +/* How to interpret identifiers in a file's ASSIGN clause */ +enum cb_assign_type { + CB_ASSIGN_VARIABLE_DEFAULT, /* default to ASSIGN variable, where allowed by implicit-assign-dynamic-var */ + CB_ASSIGN_VARIABLE_REQUIRED, /* require ASSIGN variable */ + CB_ASSIGN_EXT_FILE_NAME_REQUIRED /* require ASSIGN external-file-name */ +}; + /* DECIMAL-POINT IS COMMA effect in XML/JSON GENERATE statements */ enum cb_dpc_in_data_options { CB_DPC_IN_NONE, diff --git a/cobc/replace.c b/cobc/replace.c index 5bb91d9a8..43a4d39b5 100644 --- a/cobc/replace.c +++ b/cobc/replace.c @@ -1,5 +1,5 @@ /* - Copyright (C) 2001-2024 Free Software Foundation, Inc. + Copyright (C) 2001-2025 Free Software Foundation, Inc. Authors: Keisuke Nishida, Roger While, Ron Norman, Simon Sobisch, Brian Tiffin, @@ -248,8 +248,8 @@ struct cb_token_list { /* types */ enum cb_ppecho { - CB_PPECHO_DIRECT = 0, /* direct output */ - CB_PPECHO_REPLACE = 1, /* output to REPLACE */ + CB_PPECHO_DIRECT = 0, /* direct output */ + CB_PPECHO_REPLACE = 1 /* output to REPLACE */ }; struct cb_replacement_state { diff --git a/cobc/scanner.l b/cobc/scanner.l index c20d4ca61..b05e2ffcb 100644 --- a/cobc/scanner.l +++ b/cobc/scanner.l @@ -1,5 +1,5 @@ /* - Copyright (C) 2001-2012, 2014-2023 Free Software Foundation, Inc. + Copyright (C) 2001-2012, 2014-2025 Free Software Foundation, Inc. Written by Keisuke Nishida, Roger While, Simon Sobisch, Edwart Hart, Ron Norman @@ -143,7 +143,7 @@ enum cb_literal_type { CB_LITERAL_DEFAULT, CB_LITERAL_U, /* UTF-8, work-in-progress */ CB_LITERAL_N, - CB_LITERAL_NC, + CB_LITERAL_NC }; enum cb_sym_ebcdic_state { diff --git a/cobc/tree.h b/cobc/tree.h index 4ac1b7cf1..62a9fc357 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -1,5 +1,5 @@ /* - Copyright (C) 2001-2012, 2014-2023 Free Software Foundation, Inc. + Copyright (C) 2001-2012, 2014-2025 Free Software Foundation, Inc. Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman This file is part of GnuCOBOL. @@ -1144,13 +1144,6 @@ struct cb_alt_key { struct cb_key_component *component_list; /* List of fields making up key */ }; -/* How to interpret identifiers in a file's ASSIGN clause */ -enum cb_assign_type { - CB_ASSIGN_VARIABLE_DEFAULT, /* default to ASSIGN variable, where allowed by implicit-assign-dynamic-var */ - CB_ASSIGN_VARIABLE_REQUIRED, /* require ASSIGN variable */ - CB_ASSIGN_EXT_FILE_NAME_REQUIRED /* require ASSIGN external-file-name */ -}; - struct cb_file { struct cb_tree_common common; /* Common values */ const char *name; /* Original name */ @@ -1313,7 +1306,7 @@ enum cb_binary_op_op { BOP_SHIFT_L = 'l', /* ( x << y ) */ BOP_SHIFT_R = 'r', /* ( x >> y ) */ BOP_SHIFT_LC = 'c', /* ( x << y circular-shift) */ - BOP_SHIFT_RC = 'd', /* ( x >> y circular-shift ) */ + BOP_SHIFT_RC = 'd' /* ( x >> y circular-shift ) */ }; enum cb_binary_op_flag { @@ -1702,7 +1695,7 @@ extern void plex_action_directive (const enum cb_directive_action, enum cb_replace { CB_REPLACE_ALL = 0, CB_REPLACE_LEADING = 1, - CB_REPLACE_TRAILING = 2, + CB_REPLACE_TRAILING = 2 }; /* Strict/loose source text replacement structure */ @@ -2880,7 +2873,7 @@ extern int cobc_has_areacheck_directive (const char *directive); enum cb_colseq { CB_COLSEQ_NATIVE, CB_COLSEQ_ASCII, - CB_COLSEQ_EBCDIC, + CB_COLSEQ_EBCDIC }; extern enum cb_colseq cb_default_colseq; diff --git a/tests/testsuite.src/run_misc.at b/tests/testsuite.src/run_misc.at index f3cc36c09..ba481c31b 100644 --- a/tests/testsuite.src/run_misc.at +++ b/tests/testsuite.src/run_misc.at @@ -1,4 +1,4 @@ -## Copyright (C) 2003-2012, 2014-2024 Free Software Foundation, Inc. +## Copyright (C) 2003-2012, 2014-2025 Free Software Foundation, Inc. ## Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, ## Ron Norman ## @@ -12161,8 +12161,8 @@ AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], [libcob: prog.cob:26: error: subscript of 'TSTY' out of bounds: 0 ]) -# Runtime checks disable, subscript may be zero or even negative -AT_CHECK([$COBC -x -g -fsource-location prog.cob -o prog_unsafe], [0], [], []) +# Runtime checks disabled, subscript may be zero or even negative +AT_CHECK([$COMPILE -fno-ec=bound -o prog_unsafe prog.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog_unsafe], [0], [UNUP: 00000000 is :CCCC: SNUP: +00000000 is :CCCC: From c50fe66a3d3d60c7d076ef41210a5ac790f1d3e6 Mon Sep 17 00:00:00 2001 From: David Declerck Date: Thu, 31 Jul 2025 14:37:32 +0200 Subject: [PATCH 5/7] Merge SVN 5550, 5551 --- NEWS | 6 + cobc/ChangeLog | 15 + cobc/codegen.c | 17 +- cobc/parser.y | 20 +- cobc/tree.h | 2 +- cobc/typeck.c | 124 ++++-- libcob/ChangeLog | 25 ++ libcob/Makefile.am | 6 +- libcob/coblocal.h | 1 + libcob/common.h | 2 + libcob/exception-io.def | 16 +- libcob/exception.def | 15 +- libcob/fileio.c | 151 +++---- libcob/mlio.c | 923 ++++++++++++++++++++++++++++++++++------ libcob/statement.def | 22 +- libcob/xmlevent.def | 76 ++++ 16 files changed, 1157 insertions(+), 264 deletions(-) create mode 100644 libcob/xmlevent.def diff --git a/NEWS b/NEWS index e68801e4a..c37e6b31f 100644 --- a/NEWS +++ b/NEWS @@ -111,6 +111,12 @@ Open Plans: customization can be done using COB_PROF_FILE, COB_PROF_MAX_DEPTH and COB_PROF_FORMAT +** initial support for XML PARSE + while this feature is not implemented fully and some events are not + implemented yet, we'd like you to test this feature already; + note that for the XML-EVENT EXCEPTION, the stored exception-values in + XML-CODE and XML-TEXT registers differ from other implementations + ** new runtime configuration COB_HIDE_CURSOR, allows to hide the cursor during extended ScreenIO operations diff --git a/cobc/ChangeLog b/cobc/ChangeLog index a3e735d83..e9b967611 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -4,6 +4,21 @@ * cobc.h, tree.h, replace.c, scanner.l: fixed enum and forward definitions for C89 compat +2025-07-12 Simon Sobisch + + initial (unfinished) support for XML PARSE + * parser.y (schema_definition), tree.h (cb_schema_name): store reference + for XML SCHEMA, allowing literals and words + * typeck.c (validate_assign_name, process_undefined_assign_name): handle + XML SCHEMA references identical to SELECT ASSIGN, allowing external file + references + * typeck.c (cb_validate_program_data): call validate_assign_name for each + XML SCHEMA name + * codgen.c (output_xml_parse): pass flags to runtime (previously missing) + * codgen.c (output_param): handle XML SCHEMA names (previously crashing); + do not overwrite data/size for internal ANY LENGTH registers, as those + have to be setup by the runtime, not the generated code + 2025-06-02 Simon Sobisch * cobc.c (cobc_sig_handler) [!HAVE_SIGNAL_H]: fix compile error as diff --git a/cobc/codegen.c b/cobc/codegen.c index ce9594de2..dcda45f5a 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -4204,8 +4204,12 @@ output_param (cb_tree x, int id) break; } case CB_TAG_LOCALE_NAME: - output_param (CB_LOCALE_NAME(x)->list, id); + output_param (CB_LOCALE_NAME (x)->list, id); break; + case CB_TAG_SCHEMA_NAME: + output_param (CB_SCHEMA_NAME (x)->val, id); + break; + case CB_TAG_ALPHABET_NAME: { const struct cb_alphabet_name *abp = CB_ALPHABET_NAME (x); switch (abp->alphabet_type) { @@ -4445,7 +4449,8 @@ output_param (cb_tree x, int id) output (", "); } if (f->flag_local - && !f->flag_data_set) { + && !f->flag_data_set + && !(f->flag_internal_register && f->flag_any_length)) { output ("COB_SET_DATA (%s%d, ", CB_PREFIX_FIELD, f->id); output_data (x); @@ -8104,16 +8109,18 @@ output_set_attribute (const struct cb_field *f, cob_flags_t val_on, /* XML PARSE */ - static void output_xml_parse (struct cb_xml_parse *p) { int flags = 0; if (cb_xml_parse_xmlss) { - flags &= COB_XML_PARSE_XMLNSS; + flags |= COB_XML_PARSE_XMLNSS; } if (p->returning_national && current_prog->xml_ntext) { - flags &= COB_XML_PARSE_NATIONAL; + flags |= COB_XML_PARSE_NATIONAL; + } + if (p->validating && CB_SCHEMA_NAME_P (p->validating)) { + flags |= COB_XML_PARSE_VALIDATE_FILE; } output_block_open (); diff --git a/cobc/parser.y b/cobc/parser.y index 76b753b52..db525ec27 100644 --- a/cobc/parser.y +++ b/cobc/parser.y @@ -1,5 +1,5 @@ /* - Copyright (C) 2001-2012, 2014-2023 Free Software Foundation, Inc. + Copyright (C) 2001-2012, 2014-2025 Free Software Foundation, Inc. Written by Keisuke Nishida, Roger While, Ron Norman, Simon Sobisch, Edward Hart @@ -5104,6 +5104,7 @@ xml_schema_clause: if ($3) { current_program->schema_name_list = cb_list_add (current_program->schema_name_list, $3); + CB_SCHEMA_NAME ($3)->val = $4; } cobc_cs_check = 0; } @@ -5111,19 +5112,7 @@ xml_schema_clause: schema_definition: literal - { - $$ = $0; - if ($0) { - CB_SCHEMA_NAME ($0)->data = (const char *) CB_LITERAL ($1)->data; - } - } | WORD - { - $$ = $0; - if ($0) { - CB_SCHEMA_NAME ($0)->data = CB_REFERENCE ($1)->word->name; - } - } ; /* CURRENCY SIGN clause */ @@ -18101,8 +18090,9 @@ schema_file_or_record_name: record_name { $$ = $1; } | TOK_FILE WORD { - if (CB_SCHEMA_NAME_P (cb_ref ($2))) { - $$ = $2; + cb_tree x = cb_ref ($2); + if (CB_SCHEMA_NAME_P (x)) { + $$ = x; } else { cb_error_x ($2, _("'%s' is not a schema name"), CB_NAME ($2)); $$ = cb_error_node; diff --git a/cobc/tree.h b/cobc/tree.h index 62a9fc357..1248650f3 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -769,7 +769,7 @@ struct cb_system_name { struct cb_schema_name { struct cb_tree_common common; /* Common values */ const char *name; /* Original name */ - const char *data; /* file name */ + cb_tree val; /* file name, may be a literal or a data name, may be empty */ }; #define CB_SCHEMA_NAME(x) (CB_TREE_CAST (CB_TAG_SCHEMA_NAME, struct cb_schema_name, x)) diff --git a/cobc/typeck.c b/cobc/typeck.c index c25d2ad1f..49aaae433 100644 --- a/cobc/typeck.c +++ b/cobc/typeck.c @@ -1562,6 +1562,7 @@ cb_build_register_number_parameters (const char *name, const char *definition) } field = cb_build_index (cb_build_reference (name), cb_zero, 0, NULL); + /* note: this register needs to be local as it must keep the value in each recursive call */ CB_FIELD_PTR (field)->flag_no_init = 1; CB_FIELD_PTR (field)->flag_local = 1; CB_FIELD_PTR (field)->flag_internal_register = 1; @@ -1715,6 +1716,15 @@ cb_build_generic_register (const char *name, const char *external_definition, field->flag_is_global = (p != NULL); /* any GLOBAL found ? */ field->level = 77; + /* handle BASED */ +#if 0 /* note: currently unused */ + p = strstr (definition, "BASED"); + if (p && (*(p + 5) == ' ' || *(p + 5) == 0)) { + memset (p, ' ', 5); /* remove from local copy */ + field->flag_item_based = 1; + } +#endif + /* handle USAGE */ p = strstr (definition, "USAGE "); if (p) { @@ -4943,6 +4953,8 @@ validate_file_status (cb_tree fs) } } +/* create an implicit defined variable for ASSIGN or XML SCHEMA, + with the given assign reference name and initial value */ static void create_implicit_assign_dynamic_var (struct cb_program * const prog, cb_tree assign) @@ -4963,17 +4975,27 @@ create_implicit_assign_dynamic_var (struct cb_program * const prog, CB_FIELD_ADD (prog->working_storage, p); } +/* handle file assign name, used in ASSIGN clause or XML SCHEMA, + that has no definition */ static void -process_undefined_assign_name (struct cb_file * const f, +process_undefined_assign_name (cb_tree origin, struct cb_program * const prog) { - cb_tree assign = f->assign; - cb_tree l; - cb_tree ll; + struct cb_file *f = NULL; + struct cb_schema_name *schema = NULL; - if (f->assign_type != CB_ASSIGN_VARIABLE_DEFAULT) { - /* An error is emitted later */ - return; + cb_tree assign; + + if (CB_FILE_P (origin)) { + f = CB_FILE (origin); + if (f->assign_type != CB_ASSIGN_VARIABLE_DEFAULT) { + /* An error is emitted later */ + return; + } + assign = f->assign; + } else { + schema = CB_SCHEMA_NAME (origin); + assign = schema->val; } /* @@ -4981,9 +5003,13 @@ process_undefined_assign_name (struct cb_file * const f, name. */ if (cb_implicit_assign_dynamic_var) { - cb_verify_x (CB_TREE (f), cb_assign_variable, _("ASSIGN [TO] variable in SELECT")); + if (f) { + cb_verify_x (CB_TREE (f), cb_assign_variable, + _("ASSIGN [TO] variable in SELECT")); + } create_implicit_assign_dynamic_var (prog, assign); } else { + cb_tree l; /* Remove reference */ for (l = prog->reference_list; CB_VALUE (l) != assign && CB_VALUE (CB_CHAIN (l)) != assign; @@ -4991,65 +5017,88 @@ process_undefined_assign_name (struct cb_file * const f, if (CB_VALUE (l) == assign) { prog->reference_list = CB_CHAIN (l); } else { - ll = CB_CHAIN (CB_CHAIN (l)); + cb_tree temp = CB_CHAIN (CB_CHAIN (l)); cobc_parse_free (CB_CHAIN (l)); - CB_CHAIN (l) = ll; + CB_CHAIN (l) = temp; } /* Reinterpret word */ - f->assign = build_external_assignment_name (assign); + l = build_external_assignment_name (assign); + if (f) { + f->assign = l; + } else { + schema->val = l; + } } } -/* Ensure ASSIGN name refers to a valid identifier */ +/* ensure file assign name, used in ASSIGN clause or XML SCHEMA, + refers to a valid identifier */ static void -validate_assign_name (struct cb_file * const f, - struct cb_program * const prog) +validate_assign_name (cb_tree origin, struct cb_program * const prog) { - cb_tree assign = f->assign; + struct cb_file *f = NULL; + struct cb_schema_name *schema = NULL; + + cb_tree assign; cb_tree x; - struct cb_field *p; - if (!assign) { - return; + if (CB_FILE_P (origin)) { + f = CB_FILE (origin); + assign = f->assign; + } else { + schema = CB_SCHEMA_NAME (origin); + assign = schema->val; } - if (!CB_REFERENCE_P (assign)) { + if (!assign + || !CB_REFERENCE_P (assign)) { return; } - /* Error if assign name is same as a file name */ - for (x = prog->file_list; x; x = CB_CHAIN (x)) { - if (!strcmp (CB_FILE (CB_VALUE (x))->name, - CB_NAME (assign))) { - redefinition_error (assign); + if (CB_FILE_P (origin)) { + /* Error if assign name is same as a file name */ + for (x = prog->file_list; x; x = CB_CHAIN (x)) { + if (!strcmp (CB_FILE (CB_VALUE (x))->name, + CB_NAME (assign))) { + redefinition_error (assign); + } } } /* If assign is a 78-level, change assign to the 78-level's literal. */ - p = check_level_78 (CB_NAME (assign)); - if (p) { - char *c = (char *)CB_LITERAL (p->values)->data; - assign = CB_TREE (build_literal (CB_CATEGORY_ALPHANUMERIC, c, strlen (c))); - f->assign = assign; - return; + { + struct cb_field *p = check_level_78 (CB_NAME (assign)); + if (p) { + char *c = (char *)CB_LITERAL (p->values)->data; + x = CB_TREE (build_literal (CB_CATEGORY_ALPHANUMERIC, c, strlen (c))); + + if (f) { + f->assign = x; + } else { + schema->val = x; + } + return; + } + } if (CB_WORD_COUNT (assign) == 0) { - process_undefined_assign_name (f, prog); + process_undefined_assign_name (origin, prog); } else { /* We now know we have a variable, so can validate whether it is is allowed */ - if (f->flag_assign_no_keyword) { + if (f && f->flag_assign_no_keyword) { cb_verify_x (CB_TREE (f), cb_assign_variable, _("ASSIGN variable")); } x = cb_ref (assign); if (CB_FIELD_P (x) && CB_FIELD (x)->level == 88) { - cb_error_x (assign, _("ASSIGN data item '%s' is invalid"), - CB_NAME (assign)); + const char *msg = f ? _("ASSIGN data item '%s' is invalid") + : _("XML SCHEMA data item '%s' is invalid"); + cb_error_x (assign, msg, CB_NAME (assign)); } } } @@ -5102,7 +5151,10 @@ cb_validate_program_data (struct cb_program *prog) /* Build undeclared assignment names now */ for (l = prog->file_list; l; l = CB_CHAIN (l)) { - validate_assign_name (CB_FILE (CB_VALUE (l)), prog); + validate_assign_name (CB_VALUE (l), prog); + } + for (l = prog->schema_name_list; l; l = CB_CHAIN (l)) { + validate_assign_name (CB_VALUE (l), prog); } if (prog->cursor_pos) { @@ -11179,7 +11231,7 @@ cb_build_converting (cb_tree x, cb_tree y, cb_tree l) cb_build_alphanumeric_literal (conv_tab, 256))); } break; - case CB_TAG_REFERENCE: + case CB_TAG_REFERENCE: if (CB_ALPHABET_NAME_P (cb_ref (x)) && CB_ALPHABET_NAME_P (cb_ref (y))) { const struct cb_alphabet_name *alph_x = CB_ALPHABET_NAME (cb_ref (x)); diff --git a/libcob/ChangeLog b/libcob/ChangeLog index 17cd150df..881c683c9 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -1,4 +1,29 @@ +2025-07-15 Simon Sobisch + + initial (unfinished) support for XML PARSE + * fileio.c (cob_setup_filename), coblocal.h: extracted from other functions + and made available for libcob + * fileio.c (open_cbl_file, cob_sys_rename_file, cob_sys_check_file_exist, + cob_sys_copy_file, cob_sys_delete_file): use of cob_setup_filename + * statement.def (STMT_JSON_PARSE, STMT_XML_PARSE): fixed statement names + * statement.def, exeption.def, exception-io.def: dummy-definition + of used macros as enum for lsp-supported editors + * common.h: new definitions COB_XML_COMPAT COB_XML_PARSE_VALIDATE_FILE + * mlio.c (xml_parse): register validation and error handlers, + for validation from external XML schema, use cob_setup_filename so + name mapping works identical to SELECT ASSIGN + * xmlevent.def, mlio.c, Makefile.am: extracted XML-EVENT values from mlio.c + * mlio.c: new enum cob_xml_event along with static structures + xml_event_name and xml_event_name_len + * mlio.c (set_xml_namespace): new function setting namespace registers + * mlio.c: XML PARSE stub completely rewritten and now "functional what's + implemented"; the logic is changed to first parse the XML data in + chunks, creating internal events using registered SAX handlers into a + queue, then iterating over this to create the events and setup the + registers until the queue is empty; both the event data and the events + are cached + 2025-06-03 Simon Sobisch first VFILE update diff --git a/libcob/Makefile.am b/libcob/Makefile.am index aee63d0e9..d5bfa203c 100644 --- a/libcob/Makefile.am +++ b/libcob/Makefile.am @@ -1,7 +1,7 @@ # # Makefile gnucobol/libcob # -# Copyright (C) 2003-2012, 2014, 2017-2024 Free Software Foundation, Inc. +# Copyright (C) 2003-2012, 2014, 2017-2025 Free Software Foundation, Inc. # Written by Keisuke Nishida, Roger While, Simon Sobisch # # This file is part of GnuCOBOL. @@ -19,6 +19,8 @@ # You should have received a copy of the GNU General Public License # along with GnuCOBOL. If not, see . +EXTRA_DIST = xmlevent.def + if LOCAL_CJSON nodist_libcob_la_SOURCES = cJSON.c DISTCLEANFILES = cJSON.c cJSON.h @@ -128,7 +130,7 @@ endif lib_LTLIBRARIES = libcob.la $(lib_ci) $(lib_di) $(lib_vb) $(lib_vc) \ $(lib_od) $(lib_oc) $(lib_db) $(lib_lm) -EXTRA_DIST = fisam.c +EXTRA_DIST += fisam.c pkgincludedir = $(includedir)/libcob pkginclude_HEADERS = common.h version.h cobgetopt.h cobcapi.h \ exception.def exception-io.def statement.def diff --git a/libcob/coblocal.h b/libcob/coblocal.h index 48efbbd2a..376ba7f23 100644 --- a/libcob/coblocal.h +++ b/libcob/coblocal.h @@ -432,6 +432,7 @@ COB_HIDDEN void cob_init_numeric (cob_global *); COB_HIDDEN void cob_init_cconv (cob_global *); COB_HIDDEN void cob_init_termio (cob_global *, cob_settings *); COB_HIDDEN void cob_init_fileio (cob_global *, cob_settings *); +COB_HIDDEN char *cob_setup_filename (const cob_field *); COB_HIDDEN void cob_init_reportio (cob_global *, cob_settings *); COB_HIDDEN void cob_init_call (cob_global *, cob_settings *, const int); COB_HIDDEN void cob_init_cobcapi (cob_global *, cob_settings *); diff --git a/libcob/common.h b/libcob/common.h index ee20dd627..5ed1a8fd9 100644 --- a/libcob/common.h +++ b/libcob/common.h @@ -1223,6 +1223,7 @@ enum cob_statement { #define COB_XML_PARSE_XMLNSS (1U << 0) #define COB_XML_PARSE_NATIONAL (1U << 1) +#define COB_XML_PARSE_VALIDATE_FILE (1U << 2) /* Structure/union declarations */ @@ -1465,6 +1466,7 @@ typedef struct __cob_module { /* similar to XMLPARSE(XMLNSS) Micro Focus, IBM may be different (_very_ likely for error codes); but the main difference is to "COMPAT" */ + #define COB_XML_COMPAT 0 #define COB_XML_XMLNSS 1 cob_field function_return; /* Copy of RETURNING field */ diff --git a/libcob/exception-io.def b/libcob/exception-io.def index ab50513fb..925f6d81e 100644 --- a/libcob/exception-io.def +++ b/libcob/exception-io.def @@ -1,5 +1,5 @@ /* - Copyright (C) 2003-2012, 2014-2015, 2018-2020 Free Software Foundation, Inc. + Copyright (C) 2003-2012, 2014-2015, 2018-2020, 2025 Free Software Foundation, Inc. Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart This file is part of GnuCOBOL. @@ -21,6 +21,13 @@ /* COB_EXCEPTION (code, tag, name, fatal) */ +#ifndef COB_EXCEPTION + #define DUMMY_ENUM + #define COB_EXCEPTION(code,tag,name,fatal) tag = 0x##code + sizeof(name) + fatal, + /* dummy-definition for lsp-supported editors */ + enum exception_dummy { +#endif + /* input-output exception */ COB_EXCEPTION (0500, COB_EC_I_O, "EC-I-O", 0) @@ -73,3 +80,10 @@ COB_EXCEPTION (050A, COB_EC_I_O_RECORD_OPERATION, /* I-O status "0x" (COBOL 202x) */ COB_EXCEPTION (050C, COB_EC_I_O_RECORD_WARNING, "EC-I-O-RECORD-WARNING", 0) + + +#ifdef DUMMY_ENUM + /* dummy-definition for lsp-supported editors */ + DUMMY_END + }; +#endif diff --git a/libcob/exception.def b/libcob/exception.def index dbfa08357..55dece511 100644 --- a/libcob/exception.def +++ b/libcob/exception.def @@ -1,5 +1,5 @@ /* - Copyright (C) 2003-2012, 2014-2015, 2018-2021 Free Software Foundation, Inc. + Copyright (C) 2003-2012, 2014-2015, 2018-2021, 2025 Free Software Foundation, Inc. Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart This file is part of GnuCOBOL. @@ -21,6 +21,13 @@ /* COB_EXCEPTION (code, tag, name, fatal) */ +#ifndef COB_EXCEPTION + #define DUMMY_ENUM + #define COB_EXCEPTION(code,tag,name,fatal) tag = 0x##code + sizeof(name) + fatal, + /* dummy-definition for lsp-supported editors */ + enum exception_dummy { +#endif + /* All exceptions */ COB_EXCEPTION (FFFF, COB_EC_ALL, @@ -732,3 +739,9 @@ COB_EXCEPTION (1700, COB_EC_JSON, COB_EXCEPTION (1710, COB_EC_JSON_IMP, "EC-JSON-IMP", 1) + +#ifdef DUMMY_ENUM + /* dummy-definition for lsp-supported editors */ + DUMMY_END + }; +#endif diff --git a/libcob/fileio.c b/libcob/fileio.c index 7aca2d589..4ae694d1c 100644 --- a/libcob/fileio.c +++ b/libcob/fileio.c @@ -1731,6 +1731,7 @@ apply_file_paths (char *src) } } +/* adjust static buffer file_open_name per applicable mapping rules */ void cob_chk_file_mapping (cob_file *f, char *filename) { @@ -8235,15 +8236,15 @@ cob_savekey (cob_file *f, int idx, unsigned char *data) /* System routines */ -/* stores the parameter's content into a fresh allocated +/* stores the field's content into a fresh allocated string, which later needs to be passed to cob_free */ static void * -cob_param_no_quotes (int n) +cob_field_no_quotes (const cob_field *f) { register unsigned char *data, *s; void *mptr; - s = data = mptr = cob_get_picx_param (n, NULL, 0); + s = data = mptr = cob_get_picx (f->data, f->size, NULL, 0); if (s == NULL) { return NULL; } @@ -8259,19 +8260,45 @@ cob_param_no_quotes (int n) return mptr; } +/* stores the parameter's content into a fresh allocated + string, which later needs to be passed to cob_free */ +static void * +cob_param_no_quotes (int n) +{ + cob_field *f = cob_get_param_field (n, "cob_param_no_quotes"); + return cob_field_no_quotes(f); +} + +/* set the name for the internal filename buffer + and apply filename mapping; + returns the pointer to the static buffer */ +char * +cob_setup_filename (const cob_field *file_name) +{ + char *fn = cob_field_no_quotes (file_name); + strncpy (file_open_name, fn, (size_t)COB_FILE_MAX); + file_open_name[COB_FILE_MAX] = 0; + cob_free (fn); + + cob_chk_file_mapping (NULL, NULL); + + return file_open_name; +} + /* actual processing for CBL_OPEN_FILE and CBL_CREATE_FILE */ static int -open_cbl_file (cob_u8_ptr file_name, int file_access, - cob_u8_ptr file_handle, const int file_flags) +open_cbl_file (cob_u8_ptr fname, int file_access, + cob_u8_ptr file_handle, const int file_flags) { - char *fn; + cob_field *f; + const char *file_name; int flag = O_BINARY; int fd; - COB_UNUSED (file_name); + COB_UNUSED (fname); - fn = cob_param_no_quotes (1); - if (fn == NULL) { + f = cob_get_param_field (1, "open_cbl_file"); + if (f == NULL) { memset (file_handle, -1, (size_t)4); return -1; } @@ -8292,12 +8319,8 @@ open_cbl_file (cob_u8_ptr file_name, int file_access, return -1; } - strncpy (file_open_name, fn, (size_t)COB_FILE_MAX); - file_open_name[COB_FILE_MAX] = 0; - cob_free (fn); - cob_chk_file_mapping (NULL, NULL); - - fd = open (file_open_name, flag, COB_FILE_MODE); + file_name = cob_setup_filename (f); + fd = open (file_name, flag, COB_FILE_MODE); if (fd == -1) { int ret = errno_cob_sts (COB_STATUS_35_NOT_EXISTS); memset (file_handle, -1, (size_t)4); @@ -8455,26 +8478,23 @@ cob_sys_flush_file (unsigned char *file_handle) /* entry point and processing for library routine CBL_DELETE_FILE */ int -cob_sys_delete_file (unsigned char *file_name) +cob_sys_delete_file (unsigned char *fname) { - char *fn; + cob_field *f; + const char *file_name; int ret; - COB_UNUSED (file_name); + COB_UNUSED (fname); COB_CHK_PARMS (CBL_DELETE_FILE, 1); - fn = cob_param_no_quotes (1); - if (fn == NULL) { + f = cob_get_param_field (1, "cob_sys_delete_file"); + if (f == NULL) { return -1; } - strncpy (file_open_name, fn, (size_t)COB_FILE_MAX); - file_open_name[COB_FILE_MAX] = 0; - cob_free (fn); - cob_chk_file_mapping (NULL, NULL); - - ret = unlink (file_open_name); + file_name = cob_setup_filename (f); + ret = unlink (file_name); if (ret) { return 128; } @@ -8486,8 +8506,9 @@ cob_sys_delete_file (unsigned char *file_name) int cob_sys_copy_file (unsigned char *fname1, unsigned char *fname2) { - char *fn1; - char *fn2; + cob_field *f1; + cob_field *f2; + const char *file_name; int flag = O_BINARY; int ret; int i; @@ -8498,36 +8519,28 @@ cob_sys_copy_file (unsigned char *fname1, unsigned char *fname2) COB_CHK_PARMS (CBL_COPY_FILE, 2); - fn1 = cob_param_no_quotes (1); - if (fn1 == NULL) { + f1 = cob_get_param_field (1, "cob_sys_copy_file"); + if (f1 == NULL) { return -1; } - fn2 = cob_param_no_quotes (2); - if (fn2 == NULL) { - cob_free (fn1); + f2 = cob_get_param_field (2, "cob_sys_copy_file"); + if (f2 == NULL) { return -1; } - strncpy (file_open_name, fn1, (size_t)COB_FILE_MAX); - file_open_name[COB_FILE_MAX] = 0; - cob_free (fn1); - cob_chk_file_mapping (NULL, NULL); + file_name = cob_setup_filename (f1); flag |= O_RDONLY; - fd1 = open (file_open_name, flag, 0); + fd1 = open (file_name, flag, 0); if (fd1 == -1) { - cob_free (fn2); return errno_cob_sts (COB_STATUS_35_NOT_EXISTS); } - strncpy (file_open_name, fn2, (size_t)COB_FILE_MAX); - file_open_name[COB_FILE_MAX] = 0; - cob_free (fn2); - cob_chk_file_mapping (NULL, NULL); + file_name = cob_setup_filename (f2); flag &= ~O_RDONLY; flag |= O_CREAT | O_TRUNC | O_WRONLY; - fd2 = open (file_open_name, flag, COB_FILE_MODE); + fd2 = open (file_name, flag, COB_FILE_MODE); if (fd2 == -1) { ret = errno_cob_sts (COB_STATUS_35_NOT_EXISTS); close (fd1); @@ -8548,25 +8561,25 @@ cob_sys_copy_file (unsigned char *fname1, unsigned char *fname2) /* entry point and processing for library routine CBL_CHECK_FILE_EXIST */ int -cob_sys_check_file_exist (unsigned char *file_name, unsigned char *file_info) +cob_sys_check_file_exist (unsigned char *fname, unsigned char *file_info) { - char *fn; + cob_field *f; + const char *file_name; struct tm *tm; cob_s64_t sz; struct stat st; short y; short d, m, hh, mm, ss; - COB_UNUSED (file_name); + COB_UNUSED (fname); COB_CHK_PARMS (CBL_CHECK_FILE_EXIST, 2); - fn = cob_param_no_quotes (1); - if (fn == NULL) { + f = cob_get_param_field (1, "cob_sys_check_file_exist"); + if (f == NULL) { return -1; } if (cob_get_param_size(2) < 16) { - cob_free (fn); cob_runtime_error (_("'%s' - File detail area is too short"), "CBL_CHECK_FILE_EXIST"); #if 0 /* should be handled by the caller, TODO: check for better return code (or the one from MF/ACU) */ @@ -8576,12 +8589,9 @@ cob_sys_check_file_exist (unsigned char *file_name, unsigned char *file_info) #endif } - strncpy (file_open_name, fn, (size_t)COB_FILE_MAX); - file_open_name[COB_FILE_MAX] = 0; - cob_free (fn); - cob_chk_file_mapping (NULL, NULL); + file_name = cob_setup_filename (f); - if (stat (file_open_name, &st) < 0) { + if (stat (file_name, &st) < 0) { return 35; } @@ -8618,9 +8628,10 @@ cob_sys_check_file_exist (unsigned char *file_name, unsigned char *file_info) int cob_sys_rename_file (unsigned char *fname1, unsigned char *fname2) { - char *fn1; - char *fn2; + cob_field *f1; + cob_field *f2; char localbuff [COB_FILE_BUFF]; + const char *file_name; int ret; COB_UNUSED (fname1); @@ -8628,30 +8639,22 @@ cob_sys_rename_file (unsigned char *fname1, unsigned char *fname2) COB_CHK_PARMS (CBL_RENAME_FILE, 2); - fn1 = cob_param_no_quotes (1); - if (fn1 == NULL) { + f1 = cob_get_param_field (1, "cob_sys_rename_file"); + if (f1 == NULL) { return -1; } - fn2 = cob_param_no_quotes (2); - if (fn2 == NULL) { - cob_free (fn1); + f2 = cob_get_param_field (2, "cob_sys_rename_file"); + if (f2 == NULL) { return -1; } - strncpy (file_open_name, fn1, (size_t)COB_FILE_MAX); - file_open_name[COB_FILE_MAX] = 0; - cob_free (fn1); - cob_chk_file_mapping (NULL, NULL); - - strncpy (localbuff, file_open_name, (size_t)COB_FILE_MAX); + file_name = cob_setup_filename (f1); + strncpy (localbuff, file_name, (size_t)COB_FILE_MAX); localbuff[COB_FILE_MAX] = 0; - strncpy (file_open_name, fn2, (size_t)COB_FILE_MAX); - file_open_name[COB_FILE_MAX] = 0; - cob_free (fn2); - cob_chk_file_mapping (NULL, NULL); + file_name = cob_setup_filename (f2); - ret = rename (localbuff, file_open_name); + ret = rename (localbuff, file_name); if (ret) { return 128; } @@ -10339,7 +10342,7 @@ locate_segment (cob_u16_t heap, cob_u64_t data_loc, cob_u32_t size, void *data_b ptr_seg = ptr_seg->ptr_prev_seg; /* LCOV_EXCL_START */ if (!ptr_seg) { - cob_runtime_error (_("invalid internal call of %s"), __FUNCTION__); + cob_runtime_error (_("invalid internal call of %s"), "locate_segment"); cob_hard_failure_internal ("libcob"); } /* LCOV_EXCL_STOP */ diff --git a/libcob/mlio.c b/libcob/mlio.c index b1aba002b..a20686714 100644 --- a/libcob/mlio.c +++ b/libcob/mlio.c @@ -1,5 +1,5 @@ /* - Copyright (C) 2018-2024 Free Software Foundation, Inc. + Copyright (C) 2018-2025 Free Software Foundation, Inc. Written by Edward Hart, Simon Sobisch This file is part of GnuCOBOL. @@ -21,6 +21,7 @@ #include "config.h" +#include #include #include #include @@ -31,11 +32,23 @@ #include "coblocal.h" #if defined (WITH_XML2) -#include -#include #include #include +#include +#include +#include "libxml/xmlstring.h" +#include +#include #include + +#ifndef LIBXML_CONST_ERROR_PTR +#if LIBXML_VERSION >= 21200 +#define LIBXML_CONST_ERROR_PTR const xmlError * +#else +#define LIBXML_CONST_ERROR_PTR xmlErrorPtr /* use old ABI */ +#endif +#endif + #endif #if defined (WITH_CJSON) @@ -82,14 +95,83 @@ enum xml_code_status { XML_INTERNAL_ERROR = 600 }; +/* TODO: check for necessary cleanup */ + enum xml_parser_state { XML_PARSER_NOT_STARTED = 0, + XML_PARSER_VALIDATION_SETUP, + XML_PARSER_VALIDATION_SETUP_MEM, XML_PARSER_JUST_STARTED, + XML_PARSER_DOCUMENT_START, XML_PARSER_HAD_END_OF_INPUT, XML_PARSER_FINE, XML_PARSER_HAD_NONFATAL_ERROR, XML_PARSER_HAD_FATAL_ERROR, - XML_PARSER_FINISHED + XML_PARSER_FINISHED, + XML_PARSER_IGNORE_ERROR /* special value for suppressing errors */ +}; + +struct xml_event_data { + const char *data_ptr; /* data pointer in buff */ + size_t data_len; /* length of this data */ + struct xml_event_data *next; /* pointer to next element */ +}; + +#define COB_XML_EVENT(name,str) name, +enum cob_xml_event { + EVENT_UNKNOWN = 0, +#include "xmlevent.def" + EVENT_MAX_ENTRY /* always the last entry */ +}; +#undef COB_XML_EVENT + +/* content found in special register XML-EVENT */ +#ifdef HAVE_DESIGNATED_INITS +const char *xml_event_name[EVENT_MAX_ENTRY] = { + [EVENT_UNKNOWN] = "UNKNOWN" +#define COB_XML_EVENT(ename,str) , [ename] = str +#include "xmlevent.def" +#undef COB_XML_EVENT +}; +const size_t xml_event_name_len[EVENT_MAX_ENTRY] = { + [EVENT_UNKNOWN] = 0 +#define COB_XML_EVENT(ename,str) , [ename] = sizeof (str) - 1 +#include "xmlevent.def" +#undef COB_XML_EVENT +}; +#else +const char *xml_event_name[EVENT_MAX_ENTRY]; +size_t xml_event_name_len[EVENT_MAX_ENTRY]; +static void init_xml_event_list (void); +#endif + +struct xml_event { + enum cob_xml_event event; + struct xml_event_data *first; /* first data element */ + struct xml_event_data *last; /* last data element */ + struct xml_event *next; /* pointer to next element */ +}; + +struct xml_state { + enum xml_parser_state state; + enum xml_code_status last_xml_code; + int flags; +#if WITH_XML2 + xmlSAXHandler sax; + xmlParserCtxtPtr ctx; + xmlSchemaPtr schema; + xmlSchemaValidCtxtPtr val_ctx; + xmlSchemaSAXPlugPtr xsd_plug; + xmlParserErrors err; +#endif + struct xml_event *first_event; /* pointer to first processed event */ + struct xml_event *event; /* pointer to last processed event */ + const char *input_data_ptr; + const char *input_data_end; + void *buff; /* buffer for event data */ + size_t buff_len; /* size of current buffer for "text" + (increasing until end of XML processing) */ + size_t buff_off; /* offset in buffer, reset before each iteration */ }; enum json_code_status { @@ -97,33 +179,6 @@ enum json_code_status { JSON_INTERNAL_ERROR = 500 }; -/* content found in special register XML-EVENT */ -#define EVENT_ATTRIBUTE_CHARACTER "ATTRIBUTE-CHARACTER" -#define EVENT_ATTRIBUTE_CHARACTERS "ATTRIBUTE-CHARACTERS" -#define EVENT_ATTRIBUTE_NAME "ATTRIBUTE-NAME" -#define EVENT_ATTRIBUTE_NATIONAL_CHARACTER "ATTRIBUTE-NATIONAL-CHARACTER" -#define EVENT_COMMENT "COMMENT" -#define EVENT_CONTENT_CHARACTER "CONTENT-CHARACTER" -#define EVENT_CONTENT_CHARACTERS "CONTENT-CHARACTERS" -#define EVENT_CONTENT_NATIONAL_CHARACTER "CONTENT-NATIONAL-CHARACTER" -#define EVENT_DOCUMENT_TYPE_DECLARATION "DOCUMENT-TYPE-DECLARATION" -#define EVENT_ENCODING_DECLARATION "ENCODING-DECLARATION" -#define EVENT_END_OF_CDATA_SECTION "END-OF-CDATA-SECTION" -#define EVENT_END_OF_DOCUMENT "END-OF-DOCUMENT" -#define EVENT_END_OF_ELEMENT "END-OF-ELEMENT" -#define EVENT_END_OF_INPUT "END-OF-INPUT" -#define EVENT_EXCEPTION "EXCEPTION" -#define EVENT_NAMESPACE_DECLARATION "NAMESPACE-DECLARATION" -#define EVENT_PROCESSING_INSTRUCTION_DATA "PROCESSING-INSTRUCTION-DATA" -#define EVENT_PROCESSING_INSTRUCTION_TARGET "PROCESSING-INSTRUCTION-TARGET" -#define EVENT_STANDALONE_DECLARATION "STANDALONE-DECLARATION" -#define EVENT_START_OF_CDATA_SECTION "START-OF-CDATA-SECTION" -#define EVENT_START_OF_DOCUMENT "START-OF-DOCUMENT" -#define EVENT_START_OF_ELEMENT "START-OF-ELEMENT" -#define EVENT_UNKNOWN_REFERENCE_IN_ATTRIBUTE "UNKNOWN-REFERENCE-IN-ATTRIBUTE" -#define EVENT_UNKNOWN_REFERENCE_IN_CONTENT "UNKNOWN-REFERENCE-IN-CONTENT" -#define EVENT_UNRESOLVED_REFERENCE "UNRESOLVED-REFERENCE" -#define EVENT_VERSION_INFORMATION "VERSION-INFORMATION" static cob_global *cobglobptr; @@ -159,26 +214,202 @@ get_xml_code (void) /* set special register XML-EVENT */ static void -set_xml_event (const char *data) +set_xml_event (enum cob_xml_event event) { /* note: it is up to the compiler to ensure that this constant is read-only (and therefore no overwriting of const data happens) */ - COB_MODULE_PTR->xml_event->data = (unsigned char *) data; - COB_MODULE_PTR->xml_event->size = strlen (data); + COB_MODULE_PTR->xml_event->data = (unsigned char *)xml_event_name[event]; + COB_MODULE_PTR->xml_event->size = xml_event_name_len[event]; +} + + +#if defined (WITH_XML2) +/* add data to event buffer with given size; + returns -1 if buffer allocation is not possible */ +static int +buffer_xml_event_data (struct xml_state *state, struct xml_event_data *event_data, + const void *data, size_t size) +{ + size_t buff_free_size = state->buff_len - state->buff_off; + void *next_buffer_pos = ((unsigned char *)state->buff) + state->buff_off; + + event_data->data_ptr = next_buffer_pos; + + /* most common: enough size in the buffer, so copy and finish */ + if (size <= buff_free_size) { + memcpy (next_buffer_pos, data, size); + state->buff_off += size; + return 0; + } + + /* otherwise: allocate new buffer with additional space, preserving existing data */ + { + const size_t malloc_size = state->buff_off + + size > COB_MINI_BUFF ? size : COB_MINI_BUFF; + void *mptr = cob_fast_malloc (malloc_size); + if (mptr) { + if (state->buff_off) { + memcpy (mptr, state->buff, state->buff_off); + } + cob_free (state->buff); + state->buff = mptr; + state->buff_len = malloc_size; + memcpy (next_buffer_pos, data, size); + state->buff_off += size; + return 0; + } + } + + /* if that did not work out, set whatever our buffer provides */ + event_data->data_len = size = buff_free_size; + if (size) { + memcpy (next_buffer_pos, data, size); + state->buff_off += size; + } + return 1; +} + +/* provide event structure and does the setup in the state, + note: re-uses events if possible, allocates a new event if needed */ +static struct xml_event * +xml_event_initialized (struct xml_event *event) { + struct xml_event_data *data; + for (data = event->first; data; data = data->next) { + data->data_ptr = NULL; + } + event->last = event->first; + return event; +} + +/* provide event structure and does the setup in the state, + note: re-uses events if possible, allocates a new event if needed */ +static struct xml_event * +new_xml_event (struct xml_state *state, enum cob_xml_event xml_event) { + struct xml_event *event = state->event; + + /* re-use event structure from previous run */ + if (event) { + if (event->event == EVENT_UNKNOWN) { + /* very first element, and unsused: */ + event->event = xml_event; + return xml_event_initialized (event); + } + if (event->next) { + /* another unused element */ + event = event->next; + event->event = xml_event; + state->event = event; + return xml_event_initialized (event); + } + } + + /* no empty events from previous parsing, create a new one */ + event = cob_malloc (sizeof (struct xml_event)); + event->event = xml_event; + if (state->event) { + state->event->next = event; + } else { + state->first_event = event; + } + state->event = event; + return event; +} + +/* add data to event buffer with given size (will be calculated if -1 is specified); + returns event_data to use */ +static struct xml_event_data * +new_xml_event_data (struct xml_event *event) +{ + struct xml_event_data *event_data = event->last; + + /* re-use event structure from previous run */ + if (event_data) { + if (event_data->data_ptr == NULL) { + /* very first element, and unsused: */ + return event_data; + } + if (event_data->next) { + /* another unused element */ + return event_data->next; + } + } + + /* no empty event data from previous parsing, create a new one */ + + /* add to the current event's data*/ + event_data = cob_malloc (sizeof (struct xml_event_data)); + if (event->last) { + event->last->next = event_data; + } else { + event->first = event_data; + } + event->last = event_data; + return event_data; +} + +/* add data to event buffer with given size, ignores size = zero; + returns -1 if buffer allocation is not possible */ +static int +add_xml_event_data (struct xml_state *state, const void *data, size_t size, const int c_string) +{ + /* add to the current event's data*/ + struct xml_event_data *new_event_data; + + if (size == 0) { + /* comments, CDATA, ... may be empty */ + return 0; + } + + new_event_data = new_xml_event_data (state->event); + new_event_data->data_len = size; + + /* TODO: handle out-of-memory per IBM in the caller */ + return buffer_xml_event_data (state, new_event_data, data, size + c_string); +} + +/* add data to event buffer with given size; + returns -1 if buffer allocation is not possible */ +static int +add_xml_event_data_tag (struct xml_state *state, const xmlChar *name, size_t size) +{ + /* add to the current event's data*/ + struct xml_event_data *new_event_data = new_xml_event_data (state->event); + new_event_data->data_len = size; + + /* check if already existing in previous cached events, + which is likely for namespaces and tags */ + { + struct xml_event *event = state->first_event; + struct xml_event_data *event_data; + + while (event != state->event) { + for (event_data = event->first; event_data; event_data = event_data->next) { + if (event_data->data_len == size + && memcmp (event_data->data_ptr, name, size) == 0) { + new_event_data->data_ptr = event_data->data_ptr; + return 0; + } + } + event = event->next; + } + } + + /* TODO: handle out-of-memory per IBM in the caller */ + return buffer_xml_event_data (state, new_event_data, name, size); } +#endif /* defined (WITH_XML2) */ /* set special registers XML-TEXT / XML-NTEXT - the size is calculated if not explicit specified (size -> -1) */ + the size is calculated if not explicit specified (size -> -1) + if the state is given then the text is copied to its buffer */ static void -set_xml_text (const int ntext, const void *data, size_t size) +set_xml_text (const int ntext, const void *data, const size_t size) { - /* note: it is up to the compiler to ensure that these constants - are read-only (and therefore no overwriting of const data happens) */ if (ntext) { - /* FIXME (later): ensure in the caller that data is UTF-16 - (or the specified national character set) and swap call from strlen */ + /* TODO (later): convert input data (libxml2 uses UTF8) to UTF-16 + (or the specified national character set) */ COB_MODULE_PTR->xml_ntext->data = (unsigned char *) data; - COB_MODULE_PTR->xml_ntext->size = size != -1 ? size : strlen (data); + COB_MODULE_PTR->xml_ntext->size = size; COB_MODULE_PTR->xml_text->data = (unsigned char *) ""; COB_MODULE_PTR->xml_text->size = 0; } else { @@ -188,7 +419,52 @@ set_xml_text (const int ntext, const void *data, size_t size) COB_MODULE_PTR->xml_ntext->size = 0; } COB_MODULE_PTR->xml_text->data = (unsigned char *) data; - COB_MODULE_PTR->xml_text->size = size != -1 ? size : strlen (data); + COB_MODULE_PTR->xml_text->size = size; + } +} + +/* set special registers XML-NAMESPACE / XML-NNAMESPACE as well + as optional XML-NAMESPACE-PREFIX / XML-NNAMESPACE-PREFIX + the size is auto-calculated */ +static void +set_xml_namespace (const int ntext, const void *nsdata, const size_t ns_size, + const void *prefix, const size_t prefix_size) +{ + if (ntext) { + /* TODO (later): convert input data (libxml2 uses UTF8) to UTF-16 + (or the specified national character set) */ + COB_MODULE_PTR->xml_nnamespace->data = (unsigned char *) nsdata; + COB_MODULE_PTR->xml_nnamespace->size = ns_size; + if (prefix) { + COB_MODULE_PTR->xml_nnamespace_prefix->data = (unsigned char *) prefix; + COB_MODULE_PTR->xml_nnamespace_prefix->size = prefix_size; + } else { + COB_MODULE_PTR->xml_nnamespace_prefix->data = (unsigned char *) ""; + COB_MODULE_PTR->xml_nnamespace_prefix->size = 0; + } + COB_MODULE_PTR->xml_namespace->data = (unsigned char *) ""; + COB_MODULE_PTR->xml_namespace->size = 0; + COB_MODULE_PTR->xml_namespace_prefix->data = (unsigned char *) ""; + COB_MODULE_PTR->xml_namespace_prefix->size = 0; + } else { + /* XML-NTEXT and other XML-N... special registers are not available with ACUCOBOL */ + if (COB_MODULE_PTR->xml_namespace) { + COB_MODULE_PTR->xml_nnamespace->data = (unsigned char *) ""; + COB_MODULE_PTR->xml_nnamespace->size = 0; + } + if (COB_MODULE_PTR->xml_nnamespace_prefix) { + COB_MODULE_PTR->xml_nnamespace_prefix->data = (unsigned char *) ""; + COB_MODULE_PTR->xml_nnamespace_prefix->size = 0; + } + COB_MODULE_PTR->xml_namespace->data = (unsigned char *) nsdata; + COB_MODULE_PTR->xml_namespace->size = ns_size; + if (prefix) { + COB_MODULE_PTR->xml_namespace_prefix->data = (unsigned char *) prefix; + COB_MODULE_PTR->xml_namespace_prefix->size = prefix_size; + } else { + COB_MODULE_PTR->xml_namespace_prefix->data = (unsigned char *) ""; + COB_MODULE_PTR->xml_namespace_prefix->size = 0; + } } } @@ -371,7 +647,7 @@ get_num (cob_field * const f, void * (*strndup_func)(const char *, size_t), attr.scale = (COB_FIELD_SCALE (f) < 0) ? 0 : COB_FIELD_SCALE (f); attr.digits = (unsigned short)(num_integer_digits + num_decimal_digits); if (num_integer_digits == 0) - attr.digits++; + attr.digits++; attr.pic = get_pic_for_num_field (num_integer_digits, num_decimal_digits); @@ -405,7 +681,7 @@ get_num (cob_field * const f, void * (*strndup_func)(const char *, size_t), } #endif -#if WITH_XML2 +#if defined (WITH_XML2) /* XML strdup wrapper for get_trimmed_xml_data */ @@ -930,7 +1206,7 @@ cob_is_xml_namechar (const int c) int cob_is_valid_uri (const char *str) { -#if WITH_XML2 +#if defined (WITH_XML2) int is_valid; xmlURIPtr p; @@ -1019,21 +1295,14 @@ cob_xml_generate (cob_field *out, cob_ml_tree *tree, cob_field *count, } } -struct xml_state { - enum xml_parser_state state; - enum xml_code_status last_xml_code; - const char* dummy; -#if WITH_XML2 - xmlParserCtxtPtr *ctx; - xmlParserErrors err; -#endif - -}; - static void xml_parse (cob_field *in, cob_field *encoding, cob_field *validation, const int flags, struct xml_state *state); static void xml_free_parse_memory (struct xml_state *state); +#if defined (WITH_XML2) +static void xml_process_next_event (struct xml_state *state); +#endif + /* entry function for XML PARSE */ int cob_xml_parse (cob_field *in, cob_field *encoding, cob_field *validation, const int flags, void **saved_state) @@ -1041,6 +1310,11 @@ int cob_xml_parse (cob_field *in, cob_field *encoding, cob_field *validation, struct xml_state *state; int xml_code = get_xml_code (); + /* initial setup of registers, ensuring they are available in the + processing procedure */ + set_xml_text (0, "", 0); + set_xml_namespace (0, "", 0, NULL, 0); + /* no state yet ? first call */ if (*saved_state == NULL) { /* no field */ @@ -1048,13 +1322,14 @@ int cob_xml_parse (cob_field *in, cob_field *encoding, cob_field *validation, #if 0 /* seems like a codegen error, which should not happen */ set_xml_exception (XML_INTERNAL_ERROR); set_xml_event (EVENT_EXCEPTION); - set_xml_text (0, "", 0); return -1; #else cob_fatal_error (COB_FERROR_CODEGEN); #endif } *saved_state = cob_malloc (sizeof (struct xml_state)); + ((struct xml_state *)*saved_state)->flags = flags; + xml_code = 0; } state = (struct xml_state *)*saved_state; @@ -1064,7 +1339,6 @@ int cob_xml_parse (cob_field *in, cob_field *encoding, cob_field *validation, state->last_xml_code = XML_INTERNAL_ERROR; set_xml_exception (XML_INTERNAL_ERROR); set_xml_event (EVENT_EXCEPTION); - set_xml_text (0, "", 0); return 0; } /* likely a separate error case: emtpy item */ @@ -1072,22 +1346,12 @@ int cob_xml_parse (cob_field *in, cob_field *encoding, cob_field *validation, state->last_xml_code = XML_INTERNAL_ERROR; set_xml_exception (XML_INTERNAL_ERROR); set_xml_event (EVENT_EXCEPTION); - set_xml_text (0, "", 0); return 0; } if (encoding && is_empty (encoding)) { encoding = NULL; } - if (validation) { - if (is_empty (validation)) { - validation = NULL; - } else if (has_invalid_xml_char (validation)) { - state->last_xml_code = XML_INVALID_NAMESPACE; - set_xml_exception (XML_INVALID_NAMESPACE); - return 0; - } - } /* parser function had fatal error */ if (state->state == XML_PARSER_HAD_FATAL_ERROR) { @@ -1124,6 +1388,7 @@ int cob_xml_parse (cob_field *in, cob_field *encoding, cob_field *validation, return 1; } +#if 0 /* CHECKME: likely can be deleted now */ /* we reached "end of input" (xmlss only?) and were not told to go on */ if (state->state == XML_PARSER_HAD_END_OF_INPUT) { if (xml_code == 0) { @@ -1144,6 +1409,7 @@ int cob_xml_parse (cob_field *in, cob_field *encoding, cob_field *validation, return 1; } } +#endif if (xml_code != 0) { /* note: -1 is handled above, also 1 where possible */ @@ -1166,12 +1432,23 @@ int cob_xml_parse (cob_field *in, cob_field *encoding, cob_field *validation, return 1; } - /* do actual parsing */ +#if defined (WITH_XML2) + if (state->event + && state->event->event != EVENT_UNKNOWN) { + /* if there are still events in the queue -> get next one */ + xml_process_next_event (state); + } else { + /* do actual parsing */ + xml_parse (in, encoding, validation, flags, state); + } +#else xml_parse (in, encoding, validation, flags, state); +#endif + return 0; } -#if WITH_XML2 +#if defined (WITH_XML2) /* actual handling of XML GENERATE */ void @@ -1280,43 +1557,215 @@ xml_generate (cob_field *out, cob_ml_tree *tree, cob_field *count, } } +static void +set_xml_code_parsing_error (const int libxml2_err) { + int xml_err = 0x00000018 /* 24 COMP in split field per IBM doc */ + + (libxml2_err << 8); /* second part with error number */ +#ifdef WORDS_BIGENDIAN /* CHECKME: is that correct? */ + xml_err = COB_BSWAP_32 (xml_err); +#endif + memcpy (COB_MODULE_PTR->xml_code->data, &xml_err, sizeof (int)); +} + +static void +xml_error_handling (struct xml_state *state, const xmlError *err) { + new_xml_event (state, EVENT_EXCEPTION); + add_xml_event_data (state, err->message, strlen (err->message), 1); + { + char err_code[5]; + sprintf (err_code, "%4d", err->code); + add_xml_event_data (state, err_code, 4, 1); + } + /* CHECKME: Which other elements of the xmlError do we want to pass? */ +#if 0 /* CHECKME: Do we want that? */ + state->state = XML_PARSER_HAD_NONFATAL_ERROR; +#endif +} + +static void +xml_error_handler (void *ctx, LIBXML_CONST_ERROR_PTR err) { + struct xml_state *parse_state = ctx; + enum xml_parser_state state = parse_state->state; + static int last_error_code = 0; + + /* suppress duplicate message */ + if (err->code == XML_SCHEMAP_FAILED_LOAD + && last_error_code == XML_IO_LOAD_ERROR) { + last_error_code = err->code; + return; + } + + if (state == XML_PARSER_VALIDATION_SETUP + || state == XML_PARSER_VALIDATION_SETUP_MEM) { + /* skip schema detail issues we are not interested in */ + if (err->code < XML_IO_UNKNOWN) { + return; + } + } + + switch (state) { + case XML_PARSER_VALIDATION_SETUP: + if (err->file) { + cob_runtime_warning (_("XML PARSE setup for VALIDATE FILE %s:%d (%d): %s"), + err->file, err->line, err->code, err->message); + } else { + cob_runtime_warning (_("XML PARSE setup for VALIDATE FILE (%d): %s"), + err->code, err->message); + } + set_xml_event (EVENT_EXCEPTION); + parse_state->last_xml_code = XML_PARSE_ERROR_FATAL; + parse_state->state = XML_PARSER_HAD_FATAL_ERROR; + set_xml_code_parsing_error (err->code); + break; + case XML_PARSER_VALIDATION_SETUP_MEM: + cob_runtime_warning (_("XML PARSE setup for VALIDATE (%d): %s"), + err->code, err->message); + set_xml_event (EVENT_EXCEPTION); + parse_state->last_xml_code = XML_PARSE_ERROR_FATAL; + parse_state->state = XML_PARSER_HAD_FATAL_ERROR; + set_xml_code_parsing_error (err->code); + break; + case XML_PARSER_JUST_STARTED: + case XML_PARSER_DOCUMENT_START: + case XML_PARSER_FINE: + case XML_PARSER_HAD_NONFATAL_ERROR: + xml_error_handling (parse_state, err); + break; + default: + /* not translated as unplanned */ + cob_runtime_warning ("XML PARSE state %d on %s:%d (%d): %s", + state, err->file, err->line, err->code, err->message); + } + + last_error_code = err->code; +} + +static void +xml_startDocument (void *ctx) { + struct xml_state *state = ctx; + new_xml_event (state, EVENT_START_OF_DOCUMENT); + state->state = XML_PARSER_DOCUMENT_START; +} + +static void +xml_endDocument (void *ctx) { + struct xml_state *state = ctx; + new_xml_event (state, EVENT_END_OF_DOCUMENT); + state->state = XML_PARSER_HAD_END_OF_INPUT; +} + +static void +xml_comment (void *ctx, const xmlChar *content) { + struct xml_state *state = ctx; + new_xml_event (state, EVENT_COMMENT); + add_xml_event_data (state, content, xmlStrlen (content), 0); +} + +static void +xml_element_ns_handling (struct xml_state *state, + const xmlChar *localname, const xmlChar *prefix, const xmlChar *URI, + int nb_namespaces, const xmlChar **namespaces, + int nb_attributes, int nb_defaulted, const xmlChar **attributes) { + add_xml_event_data_tag (state, localname, xmlStrlen (localname)); + /* TODO: cleanup and code namespace stuff and check what to do on endElement */ + add_xml_event_data_tag (state, prefix, xmlStrlen (prefix)); + add_xml_event_data_tag (state, URI, xmlStrlen (URI)); +} + +static void +xml_startElementNs (void *ctx, + const xmlChar *localname, const xmlChar *prefix, const xmlChar *URI, + int nb_namespaces, const xmlChar **namespaces, + int nb_attributes, int nb_defaulted, const xmlChar **attributes) { + struct xml_state *state = ctx; + new_xml_event (state, EVENT_START_OF_ELEMENT); + xml_element_ns_handling (state, localname, prefix, URI, nb_namespaces, namespaces, + nb_attributes, nb_defaulted, attributes); +} + +static void +xml_endElementNs (void *ctx, + const xmlChar *localname, const xmlChar *prefix, const xmlChar *URI) { + struct xml_state *state = ctx; + new_xml_event (state, EVENT_END_OF_ELEMENT); + xml_element_ns_handling (state, localname, prefix, URI, + 0, NULL, 0, 0, NULL); +} + +static void +xml_startElement (void *ctx, const xmlChar *name, const xmlChar **atts) { + struct xml_state *state = ctx; + new_xml_event (state, EVENT_START_OF_ELEMENT); + add_xml_event_data_tag (state, name, xmlStrlen (name)); +} + +static void +xml_endElement (void *ctx, const xmlChar *name) { + struct xml_state *state = ctx; + new_xml_event (state, EVENT_END_OF_ELEMENT); + add_xml_event_data_tag (state, name, xmlStrlen (name)); +} + +static void +xml_characters (void *ctx, const xmlChar *content, int len) { + struct xml_state *state = ctx; + new_xml_event (state, EVENT_CONTENT_CHARACTERS); + add_xml_event_data (state, content, len, 0); +} + +static void +xml_cdata (void *ctx, const xmlChar *content, int len) { + struct xml_state *state = ctx; + new_xml_event (state, EVENT_START_OF_CDATA_SECTION); + new_xml_event (state, EVENT_CONTENT_CHARACTERS); + add_xml_event_data (state, content, len, 0); + new_xml_event (state, EVENT_END_OF_CDATA_SECTION); +} + /* actual handling of XML PARSE (not implemented yet) */ void xml_parse (cob_field *in, cob_field *encoding, cob_field *validation, const int flags, struct xml_state *state) { static int first_xml = 1; - COB_UNUSED (in); - if (validation) { - if (validation->size > 5 && memcmp (validation->data, "FILE ", 5)) { - /* TODO: read file with name validation->data + 5 into local buffer - if needed by libxml, otherwise use the file directly; - the target name should be resolved with fileio.c (cob_chk_file_mapping) */ + if (state->ctx == NULL) { + char *enc = NULL; + if (encoding) { + /* CHECKME: is there a reasonable array size to use instead? */ + enc = cob_get_picx (encoding->data, encoding->size, NULL, 0); + } + + /* setup sax-parser callbacks */ + state->sax.startDocument = xml_startDocument; + state->sax.endDocument = xml_endDocument; + state->sax.comment = xml_comment; + + if (COB_MODULE_PTR->xml_mode == COB_XML_XMLNSS) { + state->sax.initialized = XML_SAX2_MAGIC; + state->sax.startElementNs = xml_startElementNs; + state->sax.endElementNs = xml_endElementNs; } else { - /* otherwise get data via get_trimmed_data (validation) - and expect it to contain a full valid schema definition */ + state->sax.startElement = xml_startElement; + state->sax.endElement = xml_endElement; } - } + state->sax.cdataBlock = xml_cdata; + state->sax.endElement = xml_endElement; - if (state->ctx == NULL) { - char *enc = NULL; - state->ctx = cob_malloc (sizeof (xmlParserCtxtPtr)); + state->sax.characters = xml_characters; /* - * just copied without knowledge from the sample, possibly totally dumb... * The document being in memory, it have no base per RFC 2396, * and the "noname.xml" argument will serve as its base. */ - if (encoding) { - /* CHECKME: is there a reasonable array size to use instead? */ - enc = cob_get_picx (encoding->data, encoding->size, NULL, 0); - } - *state->ctx = xmlCreatePushParserCtxt (NULL, NULL, - (const char*)in->data, in->size, "noname.xml"); + state->ctx = xmlCreatePushParserCtxt (&state->sax, state, + NULL, 0, "noname.xml"); + state->input_data_ptr = (const char*)in->data; + state->input_data_end = state->input_data_ptr + in->size; + if (enc) { /* TODO (later): handle encoding */ cob_free (enc); } - if (*state->ctx == NULL) { + if (state->ctx == NULL) { state->last_xml_code = XML_PARSER_HAD_FATAL_ERROR; if (COB_MODULE_PTR->xml_mode == COB_XML_XMLNSS) { set_xml_exception (XML_PARSE_ERROR_FATAL); @@ -1324,57 +1773,258 @@ void xml_parse (cob_field *in, cob_field *encoding, cob_field *validation, set_xml_exception (XML_PARSE_ERROR_MISC_COMPAT); } set_xml_event (EVENT_EXCEPTION); - set_xml_text (0, "", 0); return; } - set_xml_event (EVENT_START_OF_DOCUMENT); - if (COB_MODULE_PTR->xml_mode == COB_XML_XMLNSS) { - set_xml_text (0, "", 0); - } else { - set_xml_text (flags & COB_XML_PARSE_NATIONAL, in->data, in->size); + + /* setup global error handler for every domain that hasn't its own */ + xmlSetStructuredErrorFunc (state, xml_error_handler); + + if (validation) { + xmlSchemaParserCtxtPtr schema_ctx; + + /* use of empty data or, + what should be catched with -fec=all up front, + LINKAGE / BASED item without data */ + if (validation->data == NULL + || is_empty (validation)) { + state->last_xml_code = XML_INVALID_NAMESPACE; + set_xml_exception (XML_INVALID_NAMESPACE); + state->state = XML_PARSER_HAD_FATAL_ERROR; + return; + } + + /* create parser context from file or memory */ + if (flags & COB_XML_PARSE_VALIDATE_FILE) { + const char *file_name = cob_setup_filename (validation); + state->state = XML_PARSER_VALIDATION_SETUP; + schema_ctx = xmlSchemaNewParserCtxt (file_name); + } else { + state->state = XML_PARSER_VALIDATION_SETUP_MEM; + schema_ctx = xmlSchemaNewMemParserCtxt ((const char *)validation->data,validation->size); + } + /* parse and compile the schema */ + if (schema_ctx) { + xmlSchemaSetParserStructuredErrors (schema_ctx, xml_error_handler, state); + state->schema = xmlSchemaParse (schema_ctx); + /* free context used to compile the schema */ + xmlSchemaFreeParserCtxt (schema_ctx); + } + + if (state->schema == NULL) { + /* don't override catched and handled errors */ + if (state->state != XML_PARSER_HAD_FATAL_ERROR) { + state->last_xml_code = XML_INVALID_NAMESPACE; + state->state = XML_PARSER_HAD_FATAL_ERROR; + set_xml_exception (XML_INVALID_NAMESPACE); + } + return; + } + + /* get validation context and plug it into the parser */ + state->val_ctx = xmlSchemaNewValidCtxt (state->schema); + if (state->val_ctx == NULL) { + xmlSchemaFree (state->schema); + state->schema = NULL; + /* don't override catched and handled errors */ + if (state->state != XML_PARSER_HAD_FATAL_ERROR) { + state->last_xml_code = XML_INVALID_NAMESPACE; + state->state = XML_PARSER_HAD_FATAL_ERROR; + set_xml_exception (XML_INVALID_NAMESPACE); + } + return; + } + state->xsd_plug = xmlSchemaSAXPlug (state->val_ctx, + &(state->ctx->sax), &(state->ctx->userData)); + + /* Note: the call above goes wrong if anything is not setup correctly + for example if there's a mix of XMLCOMPAT and validition */ + if (state->xsd_plug == NULL) { + xmlSchemaFreeValidCtxt (state->val_ctx); + state->val_ctx = NULL; + xmlSchemaFree (state->schema); + state->schema = NULL; + state->last_xml_code = XML_INTERNAL_ERROR; + state->state = XML_PARSER_HAD_FATAL_ERROR; + set_xml_exception (XML_INTERNAL_ERROR); + return; + } } - state->state = XML_PARSER_JUST_STARTED; - return; - } - if (state->state != XML_PARSER_JUST_STARTED) { - int end_of_parsing = 0; /* CHECKME: How to know this? */ - state->err = xmlParseChunk (*state->ctx, - (const char*)in->data, in->size, end_of_parsing); - } else { - state->state = XML_PARSER_HAD_END_OF_INPUT; - /* that's just an assumption and expected for the IBM sample */ - set_xml_event (EVENT_END_OF_INPUT); - set_xml_code (0); /* is that correct (seems what MF sets)? */ - return; + state->buff = cob_malloc (COB_MINI_BUFF); + state->buff_len = COB_MINI_BUFF; + + state->state = XML_PARSER_JUST_STARTED; } if (first_xml) { first_xml = 0; - cob_runtime_warning (_("%s is not implemented"), + cob_runtime_warning (_("%s is unfinished"), "XML PARSE"); } - state->last_xml_code = XML_INTERNAL_ERROR; - set_xml_exception (XML_INTERNAL_ERROR); - cob_add_exception (COB_EC_IMP_FEATURE_MISSING); - set_xml_event (EVENT_EXCEPTION); - /* in case of EXCEPTIONs - should have a pointer to the text already parsed */ - set_xml_text (flags & COB_XML_PARSE_NATIONAL, "" , 0); - state->state = XML_PARSER_HAD_FATAL_ERROR; + + /* unset existing events, allowing re-use*/ + { + struct xml_event *event; + for (event = state->first_event; event; event = event->next) { + event->event = EVENT_UNKNOWN; + } + } + state->event = state->first_event; + state->buff_off = 0; + + while (state->event == NULL + || state->event->event == EVENT_UNKNOWN) { + const int end_of_parsing = state->input_data_ptr >= state->input_data_end; + int size = state->input_data_end - state->input_data_ptr; + if (size > 100) { + size = 100; + } + state->err = xmlParseChunk (state->ctx, state->input_data_ptr, size, end_of_parsing); + if (end_of_parsing) { + break; + } + state->input_data_ptr += size; + } + + state->event = state->first_event; + xml_process_next_event (state); +} + +/* processing of parsed XML events from the queue */ +void +xml_process_next_event (struct xml_state *state) +{ + struct xml_event *event = state->event; + struct xml_event_data *data = event->first; + const int ntext = state->flags & COB_XML_PARSE_NATIONAL; + + const char *text_data = data ? data->data_ptr : NULL; + size_t text_len = data ? data->data_len : 0; + + state->event = event->next; + + set_xml_event (event->event); + set_xml_code (0); + + switch (event->event) { + + case EVENT_ATTRIBUTE_CHARACTERS: + if (text_len <= 1 + && COB_MODULE_PTR->xml_mode == COB_XML_COMPAT) { + event->event = EVENT_ATTRIBUTE_CHARACTER; + } + /* XML-TEXT already setup */ + break; + + case EVENT_CONTENT_CHARACTERS: + if (text_len <= 1 + && COB_MODULE_PTR->xml_mode == COB_XML_COMPAT) { + event->event = EVENT_CONTENT_CHARACTER; + } + /* XML-TEXT already setup */ + break; + + case EVENT_START_OF_DOCUMENT: + if (COB_MODULE_PTR->xml_mode == COB_XML_COMPAT) { + text_len = state->input_data_end - state->input_data_ptr; + text_data = state->input_data_ptr; + } + state->state = XML_PARSER_FINE; + break; + case EVENT_END_OF_DOCUMENT: + state->state = XML_PARSER_FINISHED ; + /* empty register */ + break; + + case EVENT_START_OF_CDATA_SECTION: + if (COB_MODULE_PTR->xml_mode == COB_XML_COMPAT) { + text_len = 9; + text_data = "xml_mode == COB_XML_COMPAT) { + text_len = 3; + text_data = "]]>"; + } + break; + + case EVENT_START_OF_ELEMENT: + case EVENT_END_OF_ELEMENT: + case EVENT_COMMENT: + /* XML-TEXT already setup */ + /* TODO: iterate over the next data pointers and set namespace */ + break; + + case EVENT_END_OF_INPUT: + /* empty register */ + break; + + case EVENT_EXCEPTION: + /* first data is message -> already passed as is, + second data is the libxml2 error code */ + data = data->next; + if (data && data->data_len == 4) { + set_xml_code_parsing_error (atoi (data->data_ptr)); + } + break; + /* TODO */ + case EVENT_CONTENT_NATIONAL_CHARACTER: + case EVENT_DOCUMENT_TYPE_DECLARATION: + case EVENT_ENCODING_DECLARATION: + case EVENT_NAMESPACE_DECLARATION: + case EVENT_PROCESSING_INSTRUCTION_DATA: + case EVENT_PROCESSING_INSTRUCTION_TARGET: + case EVENT_STANDALONE_DECLARATION: + case EVENT_UNKNOWN_REFERENCE_IN_ATTRIBUTE: + case EVENT_UNKNOWN_REFERENCE_IN_CONTENT: + case EVENT_UNRESOLVED_REFERENCE: + case EVENT_VERSION_INFORMATION: + default: + state->last_xml_code = XML_INTERNAL_ERROR; + set_xml_exception (XML_INTERNAL_ERROR); + set_xml_event (EVENT_EXCEPTION); + state->state = XML_PARSER_HAD_NONFATAL_ERROR; + return; + } + + set_xml_text (ntext, text_data , text_len); } void xml_free_parse_memory (struct xml_state* state) { if (state->ctx) { - xmlDocPtr doc = (*state->ctx)->myDoc; - xmlFreeDoc (doc); - xmlFreeParserCtxt (*state->ctx); - cob_free (state->ctx); + if (state->xsd_plug) { + xmlSchemaSAXUnplug (state->xsd_plug); + xmlSchemaFreeValidCtxt (state->val_ctx); + xmlSchemaFree (state->schema); + } + if (state->ctx->myDoc) { + xmlFreeDoc (state->ctx->myDoc); + } + xmlFreeParserCtxt (state->ctx); + } + if (state->buff) { + cob_free (state->buff); + } + { + struct xml_event *event = state->first_event; + while (event) { + struct xml_event *next = event->next; + struct xml_event_data *data = event->first; + while (data) { + struct xml_event_data *dnext = data->next; + cob_free (data); + data = dnext; + } + cob_free (event); + event = next; + } } cob_free (state); } -#else /* !WITH_XML2 */ +#else /* !defined (WITH_XML2) */ /* actual (non) handling of XML GENERATE */ void @@ -1410,16 +2060,17 @@ void xml_parse (cob_field *in, cob_field *encoding, cob_field *validation, COB_UNUSED (encoding); COB_UNUSED (validation); COB_UNUSED (flags); + if (first_xml) { first_xml = 0; cob_runtime_warning (_("runtime is not configured to support %s"), "XML"); } + state->last_xml_code = XML_INTERNAL_ERROR; set_xml_exception (XML_INTERNAL_ERROR); cob_add_exception (COB_EC_IMP_FEATURE_DISABLED); set_xml_event (EVENT_EXCEPTION); - set_xml_text (0, "", 0); /* nothing parsed -> always empty */ state->state = XML_PARSER_HAD_FATAL_ERROR; } @@ -1549,16 +2200,38 @@ cob_json_generate (cob_field *out, cob_ml_tree *tree, cob_field *count, void cob_init_mlio (cob_global * const g) { -#if WITH_XML2 +#if defined (WITH_XML2) LIBXML_TEST_VERSION +#endif +#ifndef HAVE_DESIGNATED_INITS + init_xml_event_list (); #endif cobglobptr = g; } + +#ifndef HAVE_DESIGNATED_INITS +void +init_xml_event_list (void) +{ + xml_event_name[EVENT_UNKNOWN] = "UNKNOWN"; +#define COB_XML_EVENT(ename,str) \ + xml_event_name[ename] = str; +#include "xmlevent.def" +#undef COB_XML_EVENT + + xml_event_name_len[EVENT_UNKNOWN] = sizeof ("UNKNOWN") - 1; +#define COB_XML_EVENT(ename,str) \ + xml_event_name_len[ename] = sizeof (str) - 1; +#include "xmlevent.def" +#undef COB_XML_EVENT +} +#endif + void cob_exit_mlio (void) { -#if WITH_XML2 +#if defined (WITH_XML2) xmlCleanupParser (); #endif } diff --git a/libcob/statement.def b/libcob/statement.def index 1f8482c80..281f3756f 100644 --- a/libcob/statement.def +++ b/libcob/statement.def @@ -1,5 +1,5 @@ /* - Copyright (C) 2022-2023 Free Software Foundation, Inc. + Copyright (C) 2022-2023, 2025 Free Software Foundation, Inc. Written by Simon Sobisch This file is part of GnuCOBOL. @@ -19,13 +19,20 @@ */ /* COB_STATEMENT (name, string representation) - + the order of these definitions may not change and new entries must always be added to the end, as those are used both as enums (cobc + libcob intern) _and_ as their integer values in generated modules: cob_trace_statement (STMT_ADD) -> cob_trace_statement (1) */ +#ifndef COB_STATEMENT + #define DUMMY_ENUM + #define COB_STATEMENT(name,string) name = sizeof (string), + /* dummy-definition for lsp-supported editors */ + enum statement_dummy { +#endif + COB_STATEMENT (STMT_ADD, "ADD") COB_STATEMENT (STMT_SUBTRACT, "SUBTRACT") COB_STATEMENT (STMT_MULTIPLY, "MULTIPLY") @@ -161,11 +168,18 @@ COB_STATEMENT (STMT_SERVICE, "SERVICE") COB_STATEMENT (STMT_TRANSFORM, "TRANSFORM") COB_STATEMENT (STMT_JSON_GENERATE, "JSON GENERATE") -COB_STATEMENT (STMT_JSON_PARSE, "JSON GENERATE") +COB_STATEMENT (STMT_JSON_PARSE, "JSON PARSE") COB_STATEMENT (STMT_XML_GENERATE, "XML GENERATE") -COB_STATEMENT (STMT_XML_PARSE, "XML GENERATE") +COB_STATEMENT (STMT_XML_PARSE, "XML PARSE") COB_STATEMENT (STMT_INIT_STORAGE, "INIT STORAGE") /* codegen intern only */ COB_STATEMENT (STMT_BEFORE_CALL, "INIT CALL") /* codegen intern only (runtime checks) */ COB_STATEMENT (STMT_BEFORE_UDF, "INIT UDF") /* codegen intern only (runtime checks) */ + + +#ifdef DUMMY_ENUM + /* dummy-definition for lsp-supported editors */ + DUMMY_END + }; +#endif diff --git a/libcob/xmlevent.def b/libcob/xmlevent.def new file mode 100644 index 000000000..1b2b7848d --- /dev/null +++ b/libcob/xmlevent.def @@ -0,0 +1,76 @@ +/* + Copyright (C) 2022, 2025 Free Software Foundation, Inc. + Written by Simon Sobisch + + This file is part of GnuCOBOL. + + The GnuCOBOL runtime library is free software: you can redistribute it + and/or modify it under the terms of the GNU Lesser General Public License + as published by the Free Software Foundation, either version 3 of the + License, or (at your option) any later version. + + GnuCOBOL is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU General Public License + along with GnuCOBOL. If not, see . +*/ + +/* COB_XML_EVENT (name, string representation), + list of all XML event names passed to COBOL, could also include + internal event names; the order does not matter +*/ + +#ifndef COB_XML_EVENT + #define DUMMY_ENUM + #define COB_XML_EVENT(name,ename) name = sizeof (ename), + /* dummy-definition for lsp-supported editors */ + enum xml_event_dummy { +#endif + +COB_XML_EVENT (EVENT_ATTRIBUTE_CHARACTERS, "ATTRIBUTE-CHARACTERS") +COB_XML_EVENT (EVENT_ATTRIBUTE_CHARACTER, "ATTRIBUTE-CHARACTER") + +COB_XML_EVENT (EVENT_ATTRIBUTE_NAME, "ATTRIBUTE-NAME") +COB_XML_EVENT (EVENT_ATTRIBUTE_NATIONAL_CHARACTER, "ATTRIBUTE-NATIONAL-CHARACTER") + +COB_XML_EVENT (EVENT_COMMENT, "COMMENT") +COB_XML_EVENT (EVENT_CONTENT_CHARACTERS, "CONTENT-CHARACTERS") +COB_XML_EVENT (EVENT_CONTENT_CHARACTER, "CONTENT-CHARACTER") +COB_XML_EVENT (EVENT_CONTENT_NATIONAL_CHARACTER, "CONTENT-NATIONAL-CHARACTER") + +COB_XML_EVENT (EVENT_DOCUMENT_TYPE_DECLARATION, "DOCUMENT-TYPE-DECLARATION") + +COB_XML_EVENT (EVENT_ENCODING_DECLARATION, "ENCODING-DECLARATION") + +COB_XML_EVENT (EVENT_START_OF_DOCUMENT, "START-OF-DOCUMENT") +COB_XML_EVENT (EVENT_END_OF_DOCUMENT, "END-OF-DOCUMENT") + +COB_XML_EVENT (EVENT_START_OF_ELEMENT, "START-OF-ELEMENT") +COB_XML_EVENT (EVENT_END_OF_ELEMENT, "END-OF-ELEMENT") + +COB_XML_EVENT (EVENT_START_OF_CDATA_SECTION, "START-OF-CDATA-SECTION") +COB_XML_EVENT (EVENT_END_OF_CDATA_SECTION, "END-OF-CDATA-SECTION") + +COB_XML_EVENT (EVENT_END_OF_INPUT, "END-OF-INPUT") + +COB_XML_EVENT (EVENT_EXCEPTION, "EXCEPTION") + +COB_XML_EVENT (EVENT_NAMESPACE_DECLARATION, "NAMESPACE-DECLARATION") +COB_XML_EVENT (EVENT_PROCESSING_INSTRUCTION_DATA, "PROCESSING-INSTRUCTION-DATA") +COB_XML_EVENT (EVENT_PROCESSING_INSTRUCTION_TARGET, "PROCESSING-INSTRUCTION-TARGET") +COB_XML_EVENT (EVENT_STANDALONE_DECLARATION, "STANDALONE-DECLARATION") + +COB_XML_EVENT (EVENT_UNKNOWN_REFERENCE_IN_ATTRIBUTE, "UNKNOWN-REFERENCE-IN-ATTRIBUTE") +COB_XML_EVENT (EVENT_UNKNOWN_REFERENCE_IN_CONTENT, "UNKNOWN-REFERENCE-IN-CONTENT") +COB_XML_EVENT (EVENT_UNRESOLVED_REFERENCE, "UNRESOLVED-REFERENCE") + +COB_XML_EVENT (EVENT_VERSION_INFORMATION, "VERSION-INFORMATION") + +#ifdef DUMMY_ENUM + /* dummy-definition for lsp-supported editors */ + DUMMY_END + }; +#endif \ No newline at end of file From 7e6bd50c197b83b7b53c2f4ff133d81fffacef03 Mon Sep 17 00:00:00 2001 From: David Declerck Date: Thu, 31 Jul 2025 15:49:53 +0200 Subject: [PATCH 6/7] Merge SVN 5552, 5553 --- ChangeLog | 15 + Makefile.am | 5 +- bin/Makefile.am | 2 +- build_aux/ChangeLog | 5 + build_aux/config.guess | 17 +- build_aux/config.sub | 28 +- build_aux/texinfo.tex | 1463 ++++++++++++++++---------- cobc/ChangeLog | 12 + cobc/Makefile.am | 2 +- cobc/cobc.c | 9 +- cobc/codegen.c | 84 +- cobc/parser.y | 6 +- cobc/typeck.c | 2 +- configure.ac | 17 +- libcob/ChangeLog | 24 + libcob/Makefile.am | 2 +- libcob/call.c | 201 +++- libcob/common.c | 29 +- libcob/common.h | 35 +- libcob/fextfh.c | 40 +- libcob/fileio.c | 4 +- m4/ax_check_define.m4 | 7 +- m4/ax_code_coverage.m4 | 12 +- m4/build-to-host.m4 | 274 +++++ m4/gettext.m4 | 99 +- m4/glibc2.m4 | 31 - m4/glibc21.m4 | 34 - m4/host-cpu-c-abi.m4 | 532 ++++++++++ m4/intdiv0.m4 | 90 -- m4/intl-thread-locale.m4 | 256 +++++ m4/intl.m4 | 288 ----- m4/intldir.m4 | 19 - m4/intlmacosx.m4 | 20 +- m4/intmax.m4 | 36 - m4/progtest.m4 | 22 +- m4/uintmax_t.m4 | 30 - tests/testsuite.src/used_binaries.at | 2 +- 37 files changed, 2462 insertions(+), 1292 deletions(-) create mode 100644 m4/build-to-host.m4 delete mode 100644 m4/glibc2.m4 delete mode 100644 m4/glibc21.m4 create mode 100644 m4/host-cpu-c-abi.m4 delete mode 100644 m4/intdiv0.m4 create mode 100644 m4/intl-thread-locale.m4 delete mode 100644 m4/intl.m4 delete mode 100644 m4/intldir.m4 delete mode 100644 m4/intmax.m4 delete mode 100644 m4/uintmax_t.m4 diff --git a/ChangeLog b/ChangeLog index 3246682d6..63f935278 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,4 +1,19 @@ +2025-07-28 Simon Sobisch + + * configure.ac: check timezone and designated initializers with -Werror + * m4/ax_code_coverage.m4, m4/ax_check_define.m4: + updated from autoconf-archive + * Makefile.am (CODE_COVERAGE_LCOV_OPTIONS_DEFAULT): silence some warnings + in lcov2 + + update gettext infrastructure from gnulib + * m4/gettext.m4, m4/intlmacosx.m4, m4/progtest.m4: updated + * m4/build-to-host.m4, m4/host-cpu-c-abi.m4, m4/intl-thread-locale.m4: + added + * m4/glibc2.m4, m4/glibc21.m4, m4/intdiv0.m4, m4/intl.m4, m4/intldir.m4, + m4/intmax.m4, m4/uintmax_t.m4: removed + 2025-06-02 Simon Sobisch * configure.ac: make signal.h optional again, even if this configuration diff --git a/Makefile.am b/Makefile.am index 3eb662eee..481713673 100644 --- a/Makefile.am +++ b/Makefile.am @@ -38,13 +38,16 @@ EXTRA_DIST = gnucobol.spec DEPENDENCIES DEPENDENCIES.md README.md HACKING include $(top_srcdir)/aminclude_static.am clean-local: code-coverage-clean -dist-clean-local: code-coverage-dist-clean +distclean-local: code-coverage-dist-clean CODE_COVERAGE_BRANCH_COVERAGE=1 CODE_COVERAGE_IGNORE_PATTERN= \ "*/cobc/pplex.c" "*/cobc/ppparse.c" "*/cobc/scanner.c" "*/cobc/parser.c" \ "*/cobc/config.def" "*/cobc/warning.def" \ "*/libcob/statement.def" +# silence some warnings in lcov2 +CODE_COVERAGE_LCOV_OPTIONS_DEFAULT= \ + --ignore-errors source --rc geninfo_unexecuted_blocks=1 # files shipped with the package that should be 755'ed: FILES_TO_BE_EXECUTABLE = $(dist_noinst_SCRIPTS) \ diff --git a/bin/Makefile.am b/bin/Makefile.am index a44fe2c1a..e0fe35fe3 100644 --- a/bin/Makefile.am +++ b/bin/Makefile.am @@ -40,7 +40,7 @@ cobfile_LDADD =$(COMMON_LIBS) include $(top_srcdir)/aminclude_static.am clean-local: code-coverage-clean -dist-clean-local: code-coverage-dist-clean +distclean-local: code-coverage-dist-clean CODE_COVERAGE_BRANCH_COVERAGE=1 CODE_COVERAGE_LCOV_OPTIONS = --no-external diff --git a/build_aux/ChangeLog b/build_aux/ChangeLog index 3775329bd..ede8f57f6 100644 --- a/build_aux/ChangeLog +++ b/build_aux/ChangeLog @@ -1,4 +1,9 @@ +2025-07-28 Simon Sobisch + + * config.guess, config.sub, texinfo.tex: updated to recent versions from + https://git.savannah.gnu.org/cgit/gnulib.git/tree/build-aux/ + 2025-02-13 Simon Sobisch * pre-inst-env.in: drop COB_ON_CYGWIN as it is set via atlocal for diff --git a/build_aux/config.guess b/build_aux/config.guess index 48a684601..a9d01fde4 100755 --- a/build_aux/config.guess +++ b/build_aux/config.guess @@ -1,10 +1,10 @@ #! /bin/sh # Attempt to guess a canonical system name. -# Copyright 1992-2024 Free Software Foundation, Inc. +# Copyright 1992-2025 Free Software Foundation, Inc. # shellcheck disable=SC2006,SC2268 # see below for rationale -timestamp='2024-07-27' +timestamp='2025-07-10' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -60,7 +60,7 @@ version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright 1992-2024 Free Software Foundation, Inc. +Copyright 1992-2025 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -1597,8 +1597,11 @@ EOF *:Unleashed:*:*) GUESS=$UNAME_MACHINE-unknown-unleashed$UNAME_RELEASE ;; - *:Ironclad:*:*) - GUESS=$UNAME_MACHINE-unknown-ironclad + x86_64:[Ii]ronclad:*:*|i?86:[Ii]ronclad:*:*) + GUESS=$UNAME_MACHINE-pc-ironclad-mlibc + ;; + *:[Ii]ronclad:*:*) + GUESS=$UNAME_MACHINE-unknown-ironclad-mlibc ;; esac @@ -1808,8 +1811,8 @@ fi exit 1 # Local variables: -# eval: (add-hook 'before-save-hook 'time-stamp) +# eval: (add-hook 'before-save-hook 'time-stamp nil t) # time-stamp-start: "timestamp='" -# time-stamp-format: "%:y-%02m-%02d" +# time-stamp-format: "%Y-%02m-%02d" # time-stamp-end: "'" # End: diff --git a/build_aux/config.sub b/build_aux/config.sub index 4aaae46f6..3d35cde17 100755 --- a/build_aux/config.sub +++ b/build_aux/config.sub @@ -1,10 +1,10 @@ #! /bin/sh # Configuration validation subroutine script. -# Copyright 1992-2024 Free Software Foundation, Inc. +# Copyright 1992-2025 Free Software Foundation, Inc. # shellcheck disable=SC2006,SC2268,SC2162 # see below for rationale -timestamp='2024-05-27' +timestamp='2025-07-10' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -76,7 +76,7 @@ Report bugs and patches to ." version="\ GNU config.sub ($timestamp) -Copyright 1992-2024 Free Software Foundation, Inc. +Copyright 1992-2025 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -145,6 +145,7 @@ case $1 in | kfreebsd*-gnu* \ | knetbsd*-gnu* \ | kopensolaris*-gnu* \ + | ironclad-* \ | linux-* \ | managarm-* \ | netbsd*-eabi* \ @@ -242,7 +243,6 @@ case $1 in | rombug \ | semi \ | sequent* \ - | siemens \ | sgi* \ | siemens \ | sim \ @@ -261,7 +261,7 @@ case $1 in basic_machine=$field1-$field2 basic_os= ;; - zephyr*) + tock* | zephyr*) basic_machine=$field1-unknown basic_os=$field2 ;; @@ -1194,7 +1194,7 @@ case $cpu-$vendor in xscale-* | xscalee[bl]-*) cpu=`echo "$cpu" | sed 's/^xscale/arm/'` ;; - arm64-* | aarch64le-*) + arm64-* | aarch64le-* | arm64_32-*) cpu=aarch64 ;; @@ -1321,6 +1321,7 @@ case $cpu-$vendor in | i960 \ | ia16 \ | ia64 \ + | intelgt \ | ip2k \ | iq2000 \ | javascript \ @@ -1522,6 +1523,10 @@ EOF kernel=nto os=`echo "$basic_os" | sed -e 's|nto|qnx|'` ;; + ironclad*) + kernel=ironclad + os=`echo "$basic_os" | sed -e 's|ironclad|mlibc|'` + ;; linux*) kernel=linux os=`echo "$basic_os" | sed -e 's|linux|gnu|'` @@ -1976,6 +1981,7 @@ case $os in | atheos* \ | auroraux* \ | aux* \ + | banan_os* \ | beos* \ | bitrig* \ | bme* \ @@ -2022,7 +2028,6 @@ case $os in | ios* \ | iris* \ | irix* \ - | ironclad* \ | isc* \ | its* \ | l4re* \ @@ -2118,6 +2123,7 @@ case $os in | sysv* \ | tenex* \ | tirtos* \ + | tock* \ | toppers* \ | tops10* \ | tops20* \ @@ -2214,6 +2220,8 @@ case $kernel-$os-$obj in ;; uclinux-uclibc*- | uclinux-gnu*- ) ;; + ironclad-mlibc*-) + ;; managarm-mlibc*- | managarm-kernel*- ) ;; windows*-msvc*-) @@ -2249,6 +2257,8 @@ case $kernel-$os-$obj in ;; *-eabi*- | *-gnueabi*-) ;; + ios*-simulator- | tvos*-simulator- | watchos*-simulator- ) + ;; none--*) # None (no kernel, i.e. freestanding / bare metal), # can be paired with an machine code file format @@ -2347,8 +2357,8 @@ echo "$cpu-$vendor${kernel:+-$kernel}${os:+-$os}${obj:+-$obj}" exit # Local variables: -# eval: (add-hook 'before-save-hook 'time-stamp) +# eval: (add-hook 'before-save-hook 'time-stamp nil t) # time-stamp-start: "timestamp='" -# time-stamp-format: "%:y-%02m-%02d" +# time-stamp-format: "%Y-%02m-%02d" # time-stamp-end: "'" # End: diff --git a/build_aux/texinfo.tex b/build_aux/texinfo.tex index 93d592193..42e686ce7 100644 --- a/build_aux/texinfo.tex +++ b/build_aux/texinfo.tex @@ -3,9 +3,9 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2024-02-10.22} +\def\texinfoversion{2025-07-15.21} % -% Copyright 1985, 1986, 1988, 1990-2024 Free Software Foundation, Inc. +% Copyright 1985, 1986, 1988, 1990-2025 Free Software Foundation, Inc. % % This texinfo.tex file is free software: you can redistribute it and/or % modify it under the terms of the GNU General Public License as @@ -156,8 +156,9 @@ % Give the space character the catcode for a space. \def\spaceisspace{\catcode`\ =10\relax} -% Likewise for ^^M, the end of line character. -\def\endlineisspace{\catcode13=10\relax} +% Used to ignore an active newline that may appear immediately after +% a macro name. +{\catcode13=\active \gdef\ignoreactivenewline{\let^^M\empty}} \chardef\dashChar = `\- \chardef\slashChar = `\/ @@ -286,7 +287,6 @@ % Avoid "undefined control sequence" errors. \def\currentchapterdefs{} \def\currentsectiondefs{} -\def\currentsection{} \def\prevchapterdefs{} \def\prevsectiondefs{} \def\currentcolordefs{} @@ -483,8 +483,8 @@ % \envdef\foo{...} % \def\Efoo{...} % -% It's the responsibility of \envdef to insert \begingroup before the -% actual body; @end closes the group after calling \Efoo. \envdef also +% \envdef inserts \begingroup before the actual body; @end calls +% \Efoo then closes the group with \endgroup. \envdef also % defines \thisenv, so the current environment is known; @end checks % whether the environment name matches. The \checkenv macro can also be % used to check whether the current environment is the one expected. @@ -951,8 +951,16 @@ \let\setfilename=\comment % @bye. -\outer\def\bye{\chappager\pagelabels\tracingstats=1\ptexend} +\outer\def\bye{% + \chappager\pagelabels + % possibly set in \printindex + \ifx\byeerror\relax\else\errmessage{\byeerror}\fi + \tracingstats=1\ptexend} +% set in \donoderef below, but we need to define this here so that +% conditionals balance inside the large \ifpdf ... \fi blocks below. +\newif\ifnodeseen +\nodeseenfalse \message{pdf,} % adobe `portable' document format @@ -971,15 +979,52 @@ \newif\ifpdf \newif\ifpdfmakepagedest +% when pdftex is run in dvi mode, \pdfoutput is defined (so \pdfoutput=1 +% can be set). So we test for \relax and 0 as well as being undefined. +\ifx\pdfoutput\thisisundefined +\else + \ifx\pdfoutput\relax + \else + \ifcase\pdfoutput + \else + \pdftrue + \fi + \fi +\fi + +\newif\ifxetex +\ifx\XeTeXrevision\thisisundefined\else + \xetextrue +\fi + +\newif\ifluatex +\ifx\luatexversion\thisisundefined\else + \luatextrue + \ifnum\luatexversion>84 + \pdftrue + \fi +\fi + +\newif\ifpdforxetex +\ifpdf + \pdforxetextrue +\fi +\ifxetex + \pdforxetextrue +\fi + + + +% Whether to use non-ASCII bytes in internal link targets. Presently this +% is almost always on. +\newif\iftxiuseunicodedestname +\txiuseunicodedestnametrue + % % For LuaTeX % -\newif\iftxiuseunicodedestname -\txiuseunicodedestnamefalse % For pdfTeX etc. - -\ifx\luatexversion\thisisundefined -\else +\ifluatex % Use Unicode destination names \txiuseunicodedestnametrue % Escape PDF strings with converting UTF-16 from UTF-8 @@ -1032,7 +1077,7 @@ % \endgroup \def\pdfescapestring#1{\directlua{PDFescstr('\luaescapestring{#1}')}} - \ifnum\luatexversion>84 + \ifpdf % For LuaTeX >= 0.85 \def\pdfdest{\pdfextension dest} \let\pdfoutput\outputmode @@ -1055,28 +1100,6 @@ \fi \fi -% when pdftex is run in dvi mode, \pdfoutput is defined (so \pdfoutput=1 -% can be set). So we test for \relax and 0 as well as being undefined. -\ifx\pdfoutput\thisisundefined -\else - \ifx\pdfoutput\relax - \else - \ifcase\pdfoutput - \else - \pdftrue - \fi - \fi -\fi - -\newif\ifpdforxetex -\pdforxetexfalse -\ifpdf - \pdforxetextrue -\fi -\ifx\XeTeXrevision\thisisundefined\else - \pdforxetextrue -\fi - % Output page labels information. % See PDF reference v.1.7 p.594, section 8.3.1. @@ -1163,58 +1186,90 @@ be supported due to the design of the PDF format; use regular TeX (DVI output) for that.)} +% definitions for pdftex or luatex with pdf output \ifpdf + % Strings in PDF outlines can either be ASCII, or encoded in UTF-16BE + % with BOM. Unfortunately there is no simple way with pdftex to output + % UTF-16, so we have to do some quite convoluted expansion games if we + % find the string contains a non-ASCII codepoint if we want these to + % display correctly. We generated the UTF-16 sequences in + % \DeclareUnicodeCharacter and we access them here. + % + \def\defpdfoutlinetextunicode#1{% + \def\pdfoutlinetext{#1}% + % + % Make UTF-8 sequences expand to UTF-16 definitions. + \passthroughcharsfalse \utfbytespdftrue + \utfviiidefinedwarningfalse + % + % Completely expand, eliminating any control sequences such as \code, + % leaving only possibly \utfbytes. + \let\utfbytes\relax + \pdfaccentliterals + \xdef\pdfoutlinetextchecked{#1}% + \checkutfbytes + }% + % Check if \utfbytes occurs in expansion. + \def\checkutfbytes{% + \expandafter\checkutfbytesz\pdfoutlinetextchecked\utfbytes\finish + }% + \def\checkutfbytesz#1\utfbytes#2\finish{% + \def\after{#2}% + \ifx\after\empty + % No further action needed. Output ASCII string as-is, as converting + % to UTF-16 is somewhat slow (and uses more space). + \global\let\pdfoutlinetext\pdfoutlinetextchecked + \else + \passthroughcharstrue % pass UTF-8 sequences unaltered + \xdef\pdfoutlinetext{\pdfoutlinetext}% + \expandafter\expandutfsixteen\expandafter{\pdfoutlinetext}\pdfoutlinetext + \fi + }% % - % Color manipulation macros using ideas from pdfcolor.tex, - % except using rgb instead of cmyk; the latter is said to render as a - % very dark gray on-screen and a very dark halftone in print, instead - % of actual black. The dark red here is dark enough to print on paper as - % nearly black, but still distinguishable for online viewing. We use - % black by default, though. - \def\rgbDarkRed{0.50 0.09 0.12} - \def\rgbBlack{0 0 0} - % - % rg sets the color for filling (usual text, etc.); - % RG sets the color for stroking (thin rules, e.g., normal _'s). - \def\pdfsetcolor#1{\pdfliteral{#1 rg #1 RG}} + \catcode2=1 % begin-group character + \catcode3=2 % end-group character % - % Set color, and create a mark which defines \thiscolor accordingly, - % so that \makeheadline knows which color to restore. - \def\curcolor{0 0 0}% - \def\setcolor#1{% - \ifx#1\curcolor\else - \xdef\currentcolordefs{\gdef\noexpand\thiscolor{#1}}% - \domark - \pdfsetcolor{#1}% - \xdef\curcolor{#1}% - \fi - } + % argument should be pure UTF-8 with no control sequences. convert to + % UTF-16BE by inserting null bytes before bytes < 128 and expanding + % UTF-8 multibyte sequences to saved UTF-16BE sequences. + \def\expandutfsixteen#1#2{% + \bgroup \asciitounicode + \passthroughcharsfalse + \let\utfbytes\asis + % + % for Byte Order Mark (BOM) + \catcode"FE=12 + \catcode"FF=12 + % + % we want to treat { and } in #1 as any other ASCII bytes. however, + % we need grouping characters for \scantokens and definitions/assignments, + % so define alternative grouping characters using control characters + % that are unlikely to occur. + % this does not affect 0x02 or 0x03 bytes arising from expansion as + % these are tokens with different catcodes. + \catcode"02=1 % begin-group character + \catcode"03=2 % end-group character + % + \expandafter\xdef\expandafter#2\scantokens{% + ^^02^^fe^^ff#1^^03}% + % NB we need \scantokens to provide both the open and close group tokens + % for \xdef otherwise there is an e-TeX error "File ended while + % scanning definition of..." + % NB \scantokens is a e-TeX command which is assumed to be provided by + % pdfTeX. + % + \egroup + }% % - \let\maincolor\rgbBlack - \pdfsetcolor{\maincolor} - \edef\thiscolor{\maincolor} - \def\currentcolordefs{} + \catcode2=12 \catcode3=12 % defaults % - \def\makefootline{% - \baselineskip24pt - \line{\pdfsetcolor{\maincolor}\the\footline}% - } + % Color support % - \def\makeheadline{% - \vbox to 0pt{% - \vskip-22.5pt - \line{% - \vbox to8.5pt{}% - % Extract \thiscolor definition from the marks. - \getcolormarks - % Typeset the headline with \maincolor, then restore the color. - \pdfsetcolor{\maincolor}\the\headline\pdfsetcolor{\thiscolor}% - }% - \vss - }% - \nointerlineskip - } + % rg sets the color for filling (usual text, etc.); + % RG sets the color for stroking (thin rules, e.g., normal _'s). + \def\pdfsetcolor#1{\pdfliteral{#1 rg #1 RG}} % + % PDF outline support % \pdfcatalog{/PageMode /UseOutlines} % @@ -1311,18 +1366,15 @@ \def\pdfoutlinetext{#1}% \else \ifx \declaredencoding \utfeight - \ifx\luatexversion\thisisundefined - % For pdfTeX with UTF-8. - % TODO: the PDF format can use UTF-16 in bookmark strings, - % but the code for this isn't done yet. - % Use ASCII approximations. - \passthroughcharsfalse - \def\pdfoutlinetext{#1}% - \else + \ifluatex % For LuaTeX with UTF-8. % Pass through Unicode characters for title texts. \passthroughcharstrue - \def\pdfoutlinetext{#1}% + \pdfaccentliterals + \xdef\pdfoutlinetext{#1}% + \else + % For pdfTeX with UTF-8. + \defpdfoutlinetextunicode{#1}% \fi \else % For non-Latin-1 or non-UTF-8 encodings. @@ -1341,14 +1393,6 @@ \safewhatsit{\pdfdest name{\pdfdestname} xyz}% } % - % used to mark target names; must be expandable. - \def\pdfmkpgn#1{#1} - % - % by default, use black for everything. - \def\urlcolor{\rgbBlack} - \let\linkcolor\rgbBlack - \def\endlink{\setcolor{\maincolor}\pdfendlink} - % % Adding outlines to PDF; macros for calculating structure of outlines % come from Petr Olsak \def\expnumber#1{\expandafter\ifx\csname#1\endcsname\relax 0% @@ -1374,7 +1418,7 @@ \def\pdfdestname{#4}% \fi % - \pdfoutline goto name{\pdfmkpgn{\pdfdestname}}#2{\pdfoutlinetext}% + \pdfoutline goto name{\pdfdestname}#2{\pdfoutlinetext}% } % \def\pdfmakeoutlines{% @@ -1385,15 +1429,18 @@ \def\thischapnum{##2}% \def\thissecnum{0}% \def\thissubsecnum{0}% + \def\indexlastsec{chap\thischapnum}% }% \def\numsecentry##1##2##3##4{% \advancenumber{chap\thischapnum}% \def\thissecnum{##2}% \def\thissubsecnum{0}% + \def\indexlastsec{sec\thissecnum}% }% \def\numsubsecentry##1##2##3##4{% \advancenumber{sec\thissecnum}% \def\thissubsecnum{##2}% + \def\indexlastsec{subsec\thissecnum}% }% \def\numsubsubsecentry##1##2##3##4{% \advancenumber{subsec\thissubsecnum}% @@ -1401,7 +1448,13 @@ \def\thischapnum{0}% \def\thissecnum{0}% \def\thissubsecnum{0}% + \let\indexlastsec\empty % + % Index initials are subsidiary to whatever sectioning command just + % occurred, usually @appendix or @chapter but occasionally a lower level. + \def\idxinitialentry##1##2##3##4{% + \expandafter\advancenumber\expandafter{\indexlastsec}% + }% % use \def rather than \let here because we redefine \chapentry et % al. a second time, below. \def\appentry{\numchapentry}% @@ -1412,6 +1465,7 @@ \def\unnsecentry{\numsecentry}% \def\unnsubsecentry{\numsubsecentry}% \def\unnsubsubsecentry{\numsubsubsecentry}% + % \readdatafile{toc}% % % Read toc second time, this time actually producing the outlines. @@ -1433,28 +1487,23 @@ \dopdfoutline{##1}{count-\expnumber{subsec##2}}{##3}{##4}}% \def\numsubsubsecentry##1##2##3##4{% count is always zero \dopdfoutline{##1}{}{##3}{##4}}% + \def\idxinitialentry##1##2##3##4{% + \dopdfoutline{##1}{}{idx.##1.##2}{##4}}% % - % PDF outlines are displayed using system fonts, instead of - % document fonts. Therefore we cannot use special characters, - % since the encoding is unknown. For example, the eogonek from - % Latin 2 (0xea) gets translated to a | character. Info from - % Staszek Wawrykiewicz, 19 Jan 2004 04:09:24 +0100. - % - % TODO this right, we have to translate 8-bit characters to - % their "best" equivalent, based on the @documentencoding. Too - % much work for too little return. Just use the ASCII equivalents - % we use for the index sort strings. - % - \indexnofonts + \ifnodeseen\else \dopdfoutlinecontents \fi % for @contents at beginning \setupdatafile % We can have normal brace characters in the PDF outlines, unlike % Texinfo index files. So set that up. \def\{{\lbracecharliteral}% \def\}{\rbracecharliteral}% \catcode`\\=\active \otherbackslash - \input \tocreadfilename + \input \tocreadfilename\relax + \ifnodeseen \dopdfoutlinecontents \fi % for @contents at end \endgroup } + \def\dopdfoutlinecontents{% + \expandafter\dopdfoutline\expandafter{\putwordTOC}{}{txi.CONTENTS}{}% + } {\catcode`[=1 \catcode`]=2 \catcode`{=\other \catcode`}=\other \gdef\lbracecharliteral[{]% @@ -1480,55 +1529,16 @@ \else \let \startlink \pdfstartlink \fi - % make a live url in pdf output. - \def\pdfurl#1{% - \begingroup - % it seems we really need yet another set of dummies; have not - % tried to figure out what each command should do in the context - % of @url. for now, just make @/ a no-op, that's the only one - % people have actually reported a problem with. - % - \normalturnoffactive - \def\@{@}% - \let\/=\empty - \makevalueexpandable - % do we want to go so far as to use \indexnofonts instead of just - % special-casing \var here? - \def\var##1{##1}% - % - \leavevmode\setcolor{\urlcolor}% - \startlink attr{/Border [0 0 0]}% - user{/Subtype /Link /A << /S /URI /URI (#1) >>}% - \endgroup} - % \pdfgettoks - Surround page numbers in #1 with @pdflink. #1 may - % be a simple number, or a list of numbers in the case of an index - % entry. - \def\pdfgettoks#1.{\setbox\boxA=\hbox{\toksA={#1.}\toksB={}\maketoks}} - \def\addtokens#1#2{\edef\addtoks{\noexpand#1={\the#1#2}}\addtoks} - \def\adn#1{\addtokens{\toksC}{#1}\global\countA=1\let\next=\maketoks} - \def\poptoks#1#2|ENDTOKS|{\let\first=#1\toksD={#1}\toksA={#2}} - \def\maketoks{% - \expandafter\poptoks\the\toksA|ENDTOKS|\relax - \ifx\first0\adn0 - \else\ifx\first1\adn1 \else\ifx\first2\adn2 \else\ifx\first3\adn3 - \else\ifx\first4\adn4 \else\ifx\first5\adn5 \else\ifx\first6\adn6 - \else\ifx\first7\adn7 \else\ifx\first8\adn8 \else\ifx\first9\adn9 - \else - \ifnum0=\countA\else\makelink\fi - \ifx\first.\let\next=\done\else - \let\next=\maketoks - \addtokens{\toksB}{\the\toksD} - \ifx\first,\addtokens{\toksB}{\space}\fi - \fi - \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi - \next} - \def\makelink{\addtokens{\toksB}% - {\noexpand\pdflink{\the\toksC}}\toksC={}\global\countA=0} + \def\pdfmakeurl#1{% + \startlink attr{/Border [0 0 0]}% + user{/Subtype /Link /A << /S /URI /URI (#1) >>}% + }% + \def\endlink{\setcolor{\maincolor}\pdfendlink} + % \def\pdflink#1{\pdflinkpage{#1}{#1}}% \def\pdflinkpage#1#2{% - \startlink attr{/Border [0 0 0]} goto name{\pdfmkpgn{#1}} + \startlink attr{/Border [0 0 0]} goto name{#1} \setcolor{\linkcolor}#2\endlink} - \def\done{\edef\st{\global\noexpand\toksA={\the\toksB}}\st} \else % non-pdf mode \let\pdfmkdest = \gobble @@ -1537,13 +1547,12 @@ \let\setcolor = \gobble \let\pdfsetcolor = \gobble \let\pdfmakeoutlines = \relax -\fi % \ifx\pdfoutput +\fi % % For XeTeX % -\ifx\XeTeXrevision\thisisundefined -\else +\ifxetex % % XeTeX version check % @@ -1569,45 +1578,8 @@ \fi % % Color support - % - \def\rgbDarkRed{0.50 0.09 0.12} - \def\rgbBlack{0 0 0} - % \def\pdfsetcolor#1{\special{pdf:scolor [#1]}} % - % Set color, and create a mark which defines \thiscolor accordingly, - % so that \makeheadline knows which color to restore. - \def\setcolor#1{% - \xdef\currentcolordefs{\gdef\noexpand\thiscolor{#1}}% - \domark - \pdfsetcolor{#1}% - } - % - \def\maincolor{\rgbBlack} - \pdfsetcolor{\maincolor} - \edef\thiscolor{\maincolor} - \def\currentcolordefs{} - % - \def\makefootline{% - \baselineskip24pt - \line{\pdfsetcolor{\maincolor}\the\footline}% - } - % - \def\makeheadline{% - \vbox to 0pt{% - \vskip-22.5pt - \line{% - \vbox to8.5pt{}% - % Extract \thiscolor definition from the marks. - \getcolormarks - % Typeset the headline with \maincolor, then restore the color. - \pdfsetcolor{\maincolor}\the\headline\pdfsetcolor{\thiscolor}% - }% - \vss - }% - \nointerlineskip - } - % % PDF outline support % % Emulate pdfTeX primitive @@ -1645,11 +1617,6 @@ \safewhatsit{\pdfdest name{\pdfdestname} xyz}% } % - % by default, use black for everything. - \def\urlcolor{\rgbBlack} - \def\linkcolor{\rgbBlack} - \def\endlink{\setcolor{\maincolor}\pdfendlink} - % \def\dopdfoutline#1#2#3#4{% \setpdfoutlinetext{#1} \setpdfdestname{#3} @@ -1663,7 +1630,6 @@ % \def\pdfmakeoutlines{% \begingroup - % % For XeTeX, counts of subentries are not necessary. % Therefore, we read toc only once. % @@ -1674,13 +1640,20 @@ % horizontal space being required in the PDF viewer. \def\partentry##1##2##3##4{}% ignore parts in the outlines \def\numchapentry##1##2##3##4{% - \dopdfoutline{##2 ##1}{1}{##3}{##4}}% + \dopdfoutline{##2 ##1}{1}{##3}{##4}% + \def\indexseclevel{2}}% \def\numsecentry##1##2##3##4{% - \dopdfoutline{##1}{2}{##3}{##4}}% + \dopdfoutline{##1}{2}{##3}{##4}% + \def\indexseclevel{3}}% \def\numsubsecentry##1##2##3##4{% - \dopdfoutline{##1}{3}{##3}{##4}}% + \dopdfoutline{##1}{3}{##3}{##4}% + \def\indexseclevel{4}}% \def\numsubsubsecentry##1##2##3##4{% - \dopdfoutline{##1}{4}{##3}{##4}}% + \dopdfoutline{##1}{4}{##3}{##4}% + \def\indexseclevel{5}}% + % + \def\idxinitialentry##1##2##3##4{% + \dopdfoutline{##1}{\indexseclevel}{idx.##1.##2}{##4}}% % \let\appentry\numchapentry% \let\appsecentry\numsecentry% @@ -1696,15 +1669,25 @@ % Therefore, the encoding and the language may not be considered. % \indexnofonts + \pdfaccentliterals + \ifnodeseen\else \dopdfoutlinecontents \fi % for @contents at beginning + % \setupdatafile % We can have normal brace characters in the PDF outlines, unlike % Texinfo index files. So set that up. \def\{{\lbracecharliteral}% \def\}{\rbracecharliteral}% \catcode`\\=\active \otherbackslash - \input \tocreadfilename + \xetexpreauxfile + \input \tocreadfilename\relax + \xetexpostauxfile + \ifnodeseen \dopdfoutlinecontents \fi % for @contents at end \endgroup } + \def\dopdfoutlinecontents{% + \expandafter\dopdfoutline\expandafter + {\putwordTOC}{1}{txi.CONTENTS}{txi.CONTENTS}% + } {\catcode`[=1 \catcode`]=2 \catcode`{=\other \catcode`}=\other \gdef\lbracecharliteral[{]% @@ -1717,7 +1700,7 @@ % However, due to a UTF-16 conversion issue of xdvipdfmx 20150315, % ``\special{pdf:dest ...}'' cannot handle non-ASCII strings. % It is fixed by xdvipdfmx 20160106 (TeX Live SVN r39753). -% + % \def\skipspaces#1{\def\PP{#1}\def\D{|}% \ifx\PP\D\let\nextsp\relax \else\let\nextsp\skipspaces @@ -1732,55 +1715,17 @@ \edef\temp{#1}% \expandafter\skipspaces\temp|\relax } - % make a live url in pdf output. - \def\pdfurl#1{% - \begingroup - % it seems we really need yet another set of dummies; have not - % tried to figure out what each command should do in the context - % of @url. for now, just make @/ a no-op, that's the only one - % people have actually reported a problem with. - % - \normalturnoffactive - \def\@{@}% - \let\/=\empty - \makevalueexpandable - % do we want to go so far as to use \indexnofonts instead of just - % special-casing \var here? - \def\var##1{##1}% - % - \leavevmode\setcolor{\urlcolor}% - \special{pdf:bann << /Border [0 0 0] - /Subtype /Link /A << /S /URI /URI (#1) >> >>}% - \endgroup} + \def\pdfmakeurl#1{% + \special{pdf:bann << /Border [0 0 0] + /Subtype /Link /A << /S /URI /URI (#1) >> >>}% + } \def\endlink{\setcolor{\maincolor}\special{pdf:eann}} - \def\pdfgettoks#1.{\setbox\boxA=\hbox{\toksA={#1.}\toksB={}\maketoks}} - \def\addtokens#1#2{\edef\addtoks{\noexpand#1={\the#1#2}}\addtoks} - \def\adn#1{\addtokens{\toksC}{#1}\global\countA=1\let\next=\maketoks} - \def\poptoks#1#2|ENDTOKS|{\let\first=#1\toksD={#1}\toksA={#2}} - \def\maketoks{% - \expandafter\poptoks\the\toksA|ENDTOKS|\relax - \ifx\first0\adn0 - \else\ifx\first1\adn1 \else\ifx\first2\adn2 \else\ifx\first3\adn3 - \else\ifx\first4\adn4 \else\ifx\first5\adn5 \else\ifx\first6\adn6 - \else\ifx\first7\adn7 \else\ifx\first8\adn8 \else\ifx\first9\adn9 - \else - \ifnum0=\countA\else\makelink\fi - \ifx\first.\let\next=\done\else - \let\next=\maketoks - \addtokens{\toksB}{\the\toksD} - \ifx\first,\addtokens{\toksB}{\space}\fi - \fi - \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi - \next} - \def\makelink{\addtokens{\toksB}% - {\noexpand\pdflink{\the\toksC}}\toksC={}\global\countA=0} \def\pdflink#1{\pdflinkpage{#1}{#1}}% \def\pdflinkpage#1#2{% \special{pdf:bann << /Border [0 0 0] /Type /Annot /Subtype /Link /A << /S /GoTo /D (#1) >> >>}% \setcolor{\linkcolor}#2\endlink} - \def\done{\edef\st{\global\noexpand\toksA={\the\toksB}}\st} -% + % % % @image support % @@ -1831,12 +1776,170 @@ \XeTeXpicfile "#1".\xeteximgext "" \fi \fi - \ifdim \wd0 >0pt width \xeteximagewidth \fi - \ifdim \wd2 >0pt height \xeteximageheight \fi \relax - \egroup - } + \ifdim \wd0 >0pt width \xeteximagewidth \fi + \ifdim \wd2 >0pt height \xeteximageheight \fi \relax + \egroup + } +\fi + +% common definitions and code for pdftex, luatex and xetex +\ifpdforxetex + % The dark red here is dark enough to print on paper as + % nearly black, but still distinguishable for online viewing. We use + % black by default, though. + \def\rgbDarkRed{0.50 0.09 0.12} + \def\rgbBlack{0 0 0} + % + % Set color, and create a mark which defines \thiscolor accordingly, + % so that \makeheadline knows which color to restore. + \def\curcolor{0 0 0}% + \def\setcolor#1{% + \ifx#1\curcolor\else + \xdef\currentcolordefs{\gdef\noexpand\thiscolor{#1}}% + \domark + \pdfsetcolor{#1}% + \xdef\curcolor{#1}% + \fi + } + % + \let\maincolor\rgbBlack + \pdfsetcolor{\maincolor} + \edef\thiscolor{\maincolor} + \def\currentcolordefs{} + % + \def\makefootline{% + \baselineskip24pt + \line{\pdfsetcolor{\maincolor}\the\footline}% + } + % + \def\makeheadline{% + \vbox to 0pt{% + \vskip-22.5pt + \line{% + \vbox to8.5pt{}% + % Extract \thiscolor definition from the marks. + \getcolormarks + % Typeset the headline with \maincolor, then restore the color. + \pdfsetcolor{\maincolor}\the\headline\pdfsetcolor{\thiscolor}% + }% + \vss + }% + \nointerlineskip + } + % + % by default, use black for everything. + \def\urlcolor{\rgbBlack} + \let\linkcolor\rgbBlack + % + % make a live url in pdf output. + \def\pdfurl#1{% + \begingroup + % it seems we really need yet another set of dummies; have not + % tried to figure out what each command should do in the context + % of @url. for now, just make @/ a no-op, that's the only one + % people have actually reported a problem with. + % + \normalturnoffactive + \def\@{@}% + \let\/=\empty + \makevalueexpandable + % do we want to go so far as to use \indexnofonts instead of just + % special-casing \var here? + \def\var##1{##1}% + % + \leavevmode\setcolor{\urlcolor}% + \pdfmakeurl{#1}% + \endgroup} + % + % \pdfgettoks - Surround page numbers in #1 with @pdflink. #1 may + % be a simple number, or a list of numbers in the case of an index + % entry. + \def\pdfgettoks#1.{\setbox\boxA=\hbox{\toksA={#1.}\toksB={}\maketoks}} + \def\addtokens#1#2{\edef\addtoks{\noexpand#1={\the#1#2}}\addtoks} + \def\adn#1{\addtokens{\toksC}{#1}\global\countA=1\let\next=\maketoks} + \def\poptoks#1#2|ENDTOKS|{\let\first=#1\toksD={#1}\toksA={#2}} + \def\maketoks{% + \expandafter\poptoks\the\toksA|ENDTOKS|\relax + \ifx\first0\adn0 + \else\ifx\first1\adn1 \else\ifx\first2\adn2 \else\ifx\first3\adn3 + \else\ifx\first4\adn4 \else\ifx\first5\adn5 \else\ifx\first6\adn6 + \else\ifx\first7\adn7 \else\ifx\first8\adn8 \else\ifx\first9\adn9 + \else + \ifnum0=\countA\else\makelink\fi + \ifx\first.\let\next=\done\else + \let\next=\maketoks + \addtokens{\toksB}{\the\toksD} + \ifx\first,\addtokens{\toksB}{\space}\fi + \fi + \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi + \next} + \def\makelink{\addtokens{\toksB}% + {\noexpand\pdflink{\the\toksC}}\toksC={}\global\countA=0} + \def\done{\edef\st{\global\noexpand\toksA={\the\toksB}}\st} \fi +\ifpdforxetex + % for pdftex. + {\catcode`^^cc=13 + \gdef\pdfaccentliteralsutfviii{% + % For PDF outline only. Unicode combining accents follow the + % character they modify. Note we need at least the first byte + % of the UTF-8 sequences to have an active catcode to allow the + % definitions to do their magic. + \def\"##1{##1^^cc^^88}% U+0308 + \def\'##1{##1^^cc^^81}% U+0301 + \def\,##1{##1^^cc^^a7}% U+0327 + \def\=##1{##1^^cc^^85}% U+0305 + \def\^##1{##1^^cc^^82}% U+0302 + \def\`##1{##1^^cc^^80}% U+0300 + \def\~##1{##1^^cc^^83}% U+0303 + \def\dotaccent##1{##1^^cc^^87}% U+0307 + \def\H##1{##1^^cc^^8b}% U+030B + \def\ogonek##1{##1^^cc^^a8}% U+0328 + \def\ringaccent##1{##1^^cc^^8a}% U+030A + \def\u##1{##1^^cc^^8c}% U+0306 + \def\ubaraccent##1{##1^^cc^^b1}% U+0331 + \def\udotaccent##1{##1^^cc^^a3}% U+0323 + \def\v##1{##1^^cc^^8c}% U+030C + % this definition of @tieaccent will only work with exactly two characters + % in argument as we need to insert the combining character between them. + \def\tieaccent##1{\tieaccentz##1}% + \def\tieaccentz##1##2{##1^^cd^^a1##2} % U+0361 + }}% + % + % for xetex and luatex, which both support extended ^^^^ escapes and + % process the Unicode codepoint as a single token. + \gdef\pdfaccentliteralsnative{% + \def\"##1{##1^^^^0308}% + \def\'##1{##1^^^^0301}% + \def\,##1{##1^^^^0327}% + \def\=##1{##1^^^^0305}% + \def\^##1{##1^^^^0302}% + \def\`##1{##1^^^^0300}% + \def\~##1{##1^^^^0303}% + \def\dotaccent##1{##1^^^^0307}% + \def\H##1{##1^^^^030b}% + \def\ogonek##1{##1^^^^0328}% + \def\ringaccent##1{##1^^^^030a}% + \def\u##1{##1^^^^0306}% + \def\ubaraccent##1{##1^^^^0331}% + \def\udotaccent##1{##1^^^^0323}% + \def\v##1{##1^^^^030c}% + \def\tieaccent##1{\tieaccentz##1}% + \def\tieaccentz##1##2{##1^^^^0361##2} % U+0361 + }% + % + % use the appropriate definition + \ifluatex + \let\pdfaccentliterals\pdfaccentliteralsnative + \else + \ifxetex + \let\pdfaccentliterals\pdfaccentliteralsnative + \else + \let\pdfaccentliterals\pdfaccentliteralsutfviii + \fi + \fi +\fi % \message{fonts,} @@ -2768,15 +2871,15 @@ % @cite unconditionally uses \sl with \smartitaliccorrection. \def\cite#1{{\sl #1}\smartitaliccorrection} -% @var unconditionally uses \sl. This gives consistency for -% parameter names whether they are in @def, @table @code or a -% regular paragraph. -% To get ttsl font for @var when used in code context, @set txicodevaristt. -% The \null is to reset \spacefactor. +% By default, use ttsl font for @var when used in code context. +% To unconditionally use \sl for @var, @clear txicodevaristt. This +% gives consistency for parameter names whether they are in @def, +% @table @code or a regular paragraph. \def\aftersmartic{} \def\var#1{% \let\saveaftersmartic = \aftersmartic \def\aftersmartic{\null\let\aftersmartic=\saveaftersmartic}% + % The \null is to reset \spacefactor. % \ifflagclear{txicodevaristt}% {\def\varnext{{{\sl #1}}\smartitaliccorrection}}% @@ -2784,7 +2887,6 @@ \varnext } -% To be removed after next release \def\SETtxicodevaristt{}% @set txicodevaristt \let\i=\smartitalic @@ -2804,7 +2906,7 @@ \def\ii#1{{\it #1}} % italic font % @b, explicit bold. Also @strong. -\def\b#1{{\bf #1}} +\def\b#1{{\bf \defcharsdefault #1}} \let\strong=\b % @sansserif, explicit sans. @@ -3035,9 +3137,7 @@ \unhbox0\ (\urefcode{#1})% \fi \else - \ifx\XeTeXrevision\thisisundefined - \unhbox0\ (\urefcode{#1})% DVI, always show arg and url - \else + \ifxetex % For XeTeX \ifurefurlonlylink % PDF plus option to not display url, show just arg @@ -3047,6 +3147,8 @@ % visibility, if the pdf is eventually used to print, etc. \unhbox0\ (\urefcode{#1})% \fi + \else + \unhbox0\ (\urefcode{#1})% DVI, always show arg and url \fi \fi \else @@ -3126,11 +3228,12 @@ % at the end of the line, or no break at all here. % Changing the value of the penalty and/or the amount of stretch affects how % preferable one choice is over the other. +% Check test cases in doc/texinfo-tex-test.texi before making any changes. \def\urefallowbreak{% \penalty0\relax - \hskip 0pt plus 2 em\relax + \hskip 0pt plus 3 em\relax \penalty1000\relax - \hskip 0pt plus -2 em\relax + \hskip 0pt plus -3 em\relax } \urefbreakstyle after @@ -3665,15 +3768,24 @@ {\font\thisecfont = #1ctt\ecsize \space at \nominalsize}% % else {\ifx\curfontstyle\bfstylename - % bold: - \font\thisecfont = #1cb\ifusingit{i}{x}\ecsize \space at \nominalsize + \etcfontbold{#1}% \else - % regular: - \font\thisecfont = #1c\ifusingit{ti}{rm}\ecsize \space at \nominalsize + \ifrmisbold + \etcfontbold{#1}% + \else + % regular: + \font\thisecfont = #1c\ifusingit{ti}{rm}\ecsize \space + at \nominalsize + \fi \fi}% \thisecfont } +\def\etcfontbold#1{% + % bold: + \font\thisecfont = #1cb\ifusingit{i}{x}\ecsize \space at \nominalsize +} + % @registeredsymbol - R in a circle. The font for the R should really % be smaller yet, but lllsize is the best we can do for now. % Adapted from the plain.tex definition of \copyright. @@ -3776,7 +3888,8 @@ } \def\finishtitlepage{% - \vskip4pt \hrule height 2pt width \hsize + \ifseenauthor \vskip4pt \else \vskip 0pt plus 1filll \fi + \hrule height 2pt width \hsize \vskip\titlepagebottomglue \finishedtitlepagetrue } @@ -3799,32 +3912,104 @@ \let\subtitlerm=\rmfont \def\subtitlefont{\subtitlerm \normalbaselineskip = 13pt \normalbaselines} +\let\savedtitle\empty +\let\savedsubtitlegroup\empty +\let\savedauthorgroup\empty + \parseargdef\title{% - \checkenv\titlepage - \vbox{\titlefonts \raggedtitlesettings #1\par}% - % print a rule at the page bottom also. - \finishedtitlepagefalse - \vskip4pt \hrule height 4pt width \hsize \vskip4pt + \expandafter\ifx\thisenv\documentinfo + \gdef\savedtitle{#1}% + \else + \checkenv\titlepage + \vbox{\titlefonts \raggedtitlesettings #1\par}% + % print a rule at the page bottom also. + \finishedtitlepagefalse + \vskip4pt \hrule height 4pt width \hsize \vskip4pt + \fi } \parseargdef\subtitle{% - \checkenv\titlepage - {\subtitlefont \rightline{#1}}% + \expandafter\ifx\thisenv\documentinfo + \ifx\savedsubtitlegroup\empty + \gdef\savedsubtitlegroup{\savedsubtitle{#1}}% + \else + \expandafter\gdef\expandafter\savedsubtitlegroup\expandafter{% + \savedsubtitlegroup\savedsubtitle{#1}}% + \fi + \else + \checkenv\titlepage + {\subtitlefont \rightline{#1}}% + \fi } % @author should come last, but may come many times. % It can also be used inside @quotation. % \parseargdef\author{% - \def\temp{\quotation}% - \ifx\thisenv\temp - \def\quotationauthor{#1}% printed in \Equotation. + \expandafter\ifx\thisenv\documentinfo + \ifx\savedauthorgroup\empty + \gdef\savedauthorgroup{\savedauthor{#1}}% + \else + \expandafter\gdef\expandafter\savedauthorgroup\expandafter{% + \savedauthorgroup\savedauthor{#1}}% + \fi \else - \checkenv\titlepage - \ifseenauthor\else \vskip 0pt plus 1filll \seenauthortrue \fi - {\secfonts\rm \leftline{#1}}% + \def\temp{\quotation}% + \ifx\thisenv\temp + \def\quotationauthor{#1}% printed in \Equotation. + \else + \checkenv\titlepage + \ifseenauthor\else \vskip 0pt plus 1filll \seenauthortrue \fi + {\secfonts\rm \leftline{#1}}% + \fi + \fi +} + +% @maketitle +{\obeylines +\gdef\maketitle{% +\titlepage +\ifx\savedtitle\empty\else + \title \savedtitle + \ifx\savedsubtitlegroup\empty\else + \savedsubtitlegroup +\fi\fi +\ifx\savedauthorgroup\empty\else + \savedauthorgroup +\fi +% start verso page if either copying or publication text is given +\ifx\copyingtext\relax + \ifx\publicationtext\relax\else + \page \vskip 0pt plus 1filll \fi +\else + \page \vskip 0pt plus 1filll +\fi +\ifx\publicationtext\relax\else + \insertpublication + \sp 1 +\fi +\ifx\copyingtext\relax\else + \insertcopying +\fi +\end titlepage +} + +% \savedauthor{#1}, called with braces. output an @author line. +\gdef\savedauthor#1{% +\author#1 +} + +% \savedsubtitle{#1}, called with braces. output a @subtitle line. +\gdef\savedsubtitle#1{% +\subtitle#1 +} +} % \obeylines + +% @documentinfo block +\envdef\documentinfo{% } +\def\Edocumentinfo{}% % Set up page headings and footings. @@ -5065,8 +5250,8 @@ % \uccode`\1=`\{ \uppercase{\def\{{1}}% \uccode`\1=`\} \uppercase{\def\}{1}}% - \let\lbracechar\{% - \let\rbracechar\}% + \def\lbracechar##1{\{}% + \def\rbracechar##1{\}}% % % % We need to get rid of all macros, leaving only the arguments (if present). @@ -5411,6 +5596,8 @@ \tolerance = 9500 \plainfrenchspacing \everypar = {}% don't want the \kern\-parindent from indentation suppression. + \let\entry\indexentry + \ifxetex\xetexpreauxfile\fi % % See comment in \requireopenindexfile. \def\indexname{#1}\ifx\indexname\indexisfl\def\indexname{f1}\fi @@ -5436,8 +5623,12 @@ \fi \fi \closein 1 + \ifxetex\xetexpostauxfile\fi \endgroup} +% Checked in @bye +\let\byeerror\relax + % If the index file starts with a backslash, forgo reading the index % file altogether. If somebody upgrades texinfo.tex they may still have % old index files using \ as the escape character. Reading this would @@ -5446,7 +5637,9 @@ \ifflagclear{txiindexescapeisbackslash}{% \uccode`\~=`\\ \uppercase{\if\noexpand~}\noexpand#1 \ifflagclear{txiskipindexfileswithbackslash}{% -\errmessage{% + % Delay the error message until the very end to give a chance + % for the whole index to be output as input for texindex. + \global\def\byeerror{% ERROR: A sorted index file in an obsolete format was skipped. To fix this problem, please upgrade your version of 'texi2dvi' or 'texi2pdf' to that at . @@ -5466,7 +5659,9 @@ }% \else \begindoublecolumns + \ifxetex\xetexpreauxfile\fi \input \jobname.\indexname s + \ifxetex\xetexpostauxfile\fi \enddoublecolumns \fi }{% @@ -5477,11 +5672,39 @@ % should work because we (hopefully) don't otherwise use @ in index files. %\catcode`\@=12\relax \catcode`\@=0\relax + \ifxetex\xetexpreauxfile\fi \input \jobname.\indexname s + \ifxetex\xetexpostauxfile\fi \enddoublecolumns }% } +\def\indexentry#1#2{% + \let\entrypagetarget\empty + \ifpdforxetex + % only link the index text to the page if no comma appears in the + % list of pages, i.e. there is only one page + \checkpagelistcomma{#2}\pagelistcomma + \expandafter\ifcase\pagelistcomma + \def\entrypagetarget{#2}% + \fi + \fi% + \entryinternal{#1}{#2}% +} + +\def\checkpagelistcomma#1#2{% + \checkpagelistcommaxx#2#1,\finish +} +\def\checkpagelistcommaxx#1#2,#3\finish{% + \def\tmp{#3}% + \ifx\tmp\empty + \def#1{0\relax} + \else + \def#1{1\relax} + \fi +} + + % These macros are used by the sorted index file itself. % Change them to control the appearance of the index. @@ -5518,7 +5741,6 @@ \def\initial{% \bgroup - \initialglyphs \initialx } @@ -5541,7 +5763,10 @@ % % No shrink because it confuses \balancecolumns. \vskip 1.67\baselineskip plus 1\baselineskip - \leftline{\secfonts \kern-0.05em \secbf #1}% + \doindexinitialentry{#1}% + \initialglyphs + \leftline{% + \secfonts \kern-0.05em \secbf #1}% % \secfonts is inside the argument of \leftline so that the change of % \baselineskip will not affect any glue inserted before the vbox that % \leftline creates. @@ -5551,6 +5776,28 @@ \egroup % \initialglyphs } +\def\doindexinitialentry#1{% + \ifpdforxetex + \global\advance\idxinitialno by 1 + \def\indexlbrace{\{}% + \def\indexrbrace{\}}% + \def\indexbackslash{\realbackslash}% + \def\indexatchar{\@}% + \writetocentry{idxinitial}{\asis #1}{IDX\the\idxinitialno}% + % The @asis removes a pair of braces around e.g. {@indexatchar} that + % are output by texindex. + % + \pdfmkdest{idx.\asis #1.IDX\the\idxinitialno}% + \fi +} + +% No listing in TOC +\def\idxinitialentry#1#2#3#4{} + +% For index initials. +\newcount\idxinitialno \idxinitialno=1 + + \newdimen\entryrightmargin \entryrightmargin=0pt @@ -5559,16 +5806,18 @@ \newdimen\entrycontskip \entrycontskip=1em -% for PDF output, whether to make the text of the entry a link to the page -% number. set for @contents and @shortcontents where there is only one -% page number. +% for PDF output, whether to make the text of the entry a link to the section. +% set for @contents and @shortcontents. \newif\iflinkentrytext -% \entry typesets a paragraph consisting of the text (#1), dot leaders, and -% then page number (#2) flushed to the right margin. It is used for index -% and table of contents entries. The paragraph is indented by \leftskip. -% -\def\entry{% +% \entryinternal typesets a paragraph consisting of the text (#1), dot +% leaders, and then page number (#2) flushed to the right margin. It is +% used for index and table of contents entries. The paragraph is indented +% by \leftskip. +% For PDF output, if \linkentrytexttrue and \tocnodetarget is set, link text +% to the referenced node. Else if \entrypagetarget is set, link text to the +% page. +\def\entryinternal{% \begingroup % % Start a new paragraph if necessary, so our assignments below can't @@ -5608,9 +5857,19 @@ \global\setbox\boxA=\hbox\bgroup \ifpdforxetex \iflinkentrytext - \pdflinkpage{#1}{\unhbox\boxA}% + \ifx\tocnodetarget\empty + \unhbox\boxA + \else + \startxreflink{\tocnodetarget}{}% + \unhbox\boxA + \endlink + \fi \else - \unhbox\boxA + \ifx\entrypagetarget\empty + \unhbox\boxA + \else + \pdflinkpage{\entrypagetarget}{\unhbox\boxA}% + \fi \fi \else \unhbox\boxA @@ -5625,11 +5884,18 @@ % \null\nobreak\indexdotfill % Have leaders before the page number. % + \hskip\skip\thinshrinkable \ifpdforxetex - \pdfgettoks#1.% - \hskip\skip\thinshrinkable\the\toksA + \ifx\tocnodetarget\empty + \pdfgettoks#1.% + \the\toksA + \else + % Should just be a single page number in toc + \startxreflink{\tocnodetarget}{}% + #1\endlink + \fi \else - \hskip\skip\thinshrinkable #1% + #1% \fi \fi \egroup % end \boxA @@ -6275,6 +6541,10 @@ \parseargdef\subsubheading{\sectionheading{#1}{subsubsec}{Yomitfromtoc}{} \suppressfirstparagraphindent} +% @xrefname - give text with printed name for linking to node and allow +% referencing node, but do not print any heading. +\parseargdef\xrefname{\donoderef{Yomitfromtoc}{#1}}% + % These macros generate a chapter, section, etc. heading only % (including whitespace, linebreaking, etc. around it), % given all the information in convenient, parsed form. @@ -6396,11 +6666,6 @@ \chapfonts \rm \let\footnote=\errfootnoteheading % give better error message % - % Have to define \currentsection before calling \donoderef, because the - % xref code eventually uses it. On the other hand, it has to be called - % after \pchapsepmacro, or the headline will change too soon. - \gdef\currentsection{#1}% - % % Only insert the separating space if we have a chapter/appendix % number, and don't print the unnumbered ``number''. \ifx\temptype\Ynothingkeyword @@ -6427,7 +6692,7 @@ % been typeset. If the destination for the pdf outline is after the % text, then jumping from the outline may wind up with the text not % being visible, for instance under high magnification. - \donoderef{#2}% + \donoderef{#2}{#1}% % % Typeset the actual heading. \nobreak % Avoid page breaks at the interline glue. @@ -6543,21 +6808,17 @@ \ifx\temptype\Ynothingkeyword \setbox0 = \hbox{}% \def\toctype{unn}% - \gdef\currentsection{#1}% \else\ifx\temptype\Yomitfromtockeyword - % for @headings -- no section number, don't include in toc, - % and don't redefine \currentsection. + % for @headings -- no section number, don't include in toc. \setbox0 = \hbox{}% \def\toctype{omit}% \let\sectionlevel=\empty \else\ifx\temptype\Yappendixkeyword \setbox0 = \hbox{#4\enspace}% \def\toctype{app}% - \gdef\currentsection{#1}% \else \setbox0 = \hbox{#4\enspace}% \def\toctype{num}% - \gdef\currentsection{#1}% \fi\fi\fi % % Write the toc entry (before \donoderef). See comments in \chapmacro. @@ -6565,7 +6826,7 @@ % % Write the node reference (= pdf destination for pdftex). % Again, see comments in \chapmacro. - \donoderef{#3}% + \donoderef{#3}{#1}% % % Interline glue will be inserted when the vbox is completed. % That glue will be a valid breakpoint for the page, since it'll be @@ -6759,12 +7020,13 @@ % Prepare to read what we've written to \tocfile. % -\def\startcontents#1{% +\def\startcontents#1#2{% % If @setchapternewpage on, and @headings double, the contents should % start on an odd page, unlike chapters. \contentsalignmacro \immediate\closeout\tocfile % + #2% % Don't need to put `Contents' or `Short Contents' in the headline. % It is abundantly clear what they are. \chapmacro{#1}{Yomitfromtoc}{}% @@ -6784,7 +7046,7 @@ % \raggedbottom in plain.tex hardcodes \topskip so override it \catcode`\@=11 -\def\raggedbottom{\advance\topskip by 0pt plus60pt \r@ggedbottomtrue} +\def\raggedbottom{\advance\topskip by 0pt plus30pt \r@ggedbottomtrue} \catcode`\@=\other % redefined for the two-volume lispref. We always output on @@ -6795,7 +7057,9 @@ % Normal (long) toc. % \def\contents{% - \startcontents{\putwordTOC}% + \startcontents{\putwordTOC}{\contentsmkdest}% + \ifxetex\xetexpreauxfile\fi + \penalty2 % mark beginning of contents \openin 1 \tocreadfilename\space \ifeof 1 \else \findsecnowidths @@ -6807,13 +7071,18 @@ \pdfmakeoutlines \fi \closein 1 + \ifxetex\xetexpostauxfile\fi \endgroup \contentsendroman } +\def\contentsmkdest{% + \pdfmkdest{txi.CONTENTS}% +} + % And just the chapters. \def\summarycontents{% - \startcontents{\putwordShortTOC}% + \startcontents{\putwordShortTOC}{}% % \let\partentry = \shortpartentry \let\numchapentry = \shortchapentry @@ -6836,11 +7105,13 @@ \let\numsubsubsecentry = \numsecentry \let\appsubsubsecentry = \numsecentry \let\unnsubsubsecentry = \numsecentry + \ifxetex\xetexpreauxfile\fi \openin 1 \tocreadfilename\space \ifeof 1 \else \readtocfile \fi \closein 1 + \ifxetex\xetexpostauxfile\fi \vfill \eject \contentsalignmacro % in case @setchapternewpage odd is in effect \endgroup @@ -6881,36 +7152,45 @@ % #3 - level of section (e.g "chap", "sec") % #4 - page number -% Parts, in the main contents. Replace the part number, which doesn't -% exist, with an empty box. Let's hope all the numbers have the same width. -% Also ignore the page number, which is conventionally not printed. -\def\numeralbox{\setbox0=\hbox{8}\hbox to \wd0{\hfil}} +% Parts, in the main contents. Ignore the page number, which is +% conventionally not printed. \def\partentry#1#2#3#4{% + \ifnum\lastpenalty = 2 + % use less space if at very first entry of contents + \vskip 1\baselineskip plus .33\baselineskip minus .25\baselineskip + \else + \vskip 2\baselineskip plus .66\baselineskip minus .5\baselineskip + \fi % Add stretch and a bonus for breaking the page before the part heading. % This reduces the chance of the page being broken immediately after the % part heading, before a following chapter heading. - \vskip 0pt plus 5\baselineskip + \vskip 0pt plus 3\baselineskip \penalty-300 - \vskip 0pt plus -5\baselineskip - \dochapentry{#1}{\numeralbox}{}% + \vskip 0pt plus -3\baselineskip + \begingroup + \secfonts \rm + \entryinternal{#1}{}% + \endgroup + \afterpartentrytrue } +\newif\ifafterpartentry % % Parts, in the short toc. \def\shortpartentry#1#2#3#4{% \penalty-300 \vskip.5\baselineskip plus.15\baselineskip minus.1\baselineskip - \shortchapentry{{\bf #1}}{\numeralbox}{}{}% + \tocentry{{\bf #1}}{}{}{}% } % Chapters, in the main contents. \def\numchapentry#1#2#3#4{% \retrievesecnowidth\secnowidthchap{#2}% - \dochapentry{#1}{#2}{#4}% + \dochapentry{#1}{#2}{#3}{#4}% } % Chapters, in the short toc. \def\shortchapentry#1#2#3#4{% - \tocentry{#1}{\shortchaplabel{#2}}{#4}% + \tocentry{#1}{\shortchaplabel{#2}}{#3}{#4}% } % Appendices, in the main contents. @@ -6923,79 +7203,83 @@ % \def\appentry#1#2#3#4{% \retrievesecnowidth\secnowidthchap{#2}% - \dochapentry{\appendixbox{#2}\hskip.7em#1}{}{#4}% + \dochapentry{\appendixbox{#2}\hskip.7em#1}{}{#3}{#4}% } % Unnumbered chapters. -\def\unnchapentry#1#2#3#4{\dochapentry{#1}{}{#4}} -\def\shortunnchapentry#1#2#3#4{\tocentry{#1}{}{#4}} +\def\unnchapentry#1#2#3#4{\dochapentry{#1}{}{#3}{#4}} +\def\shortunnchapentry#1#2#3#4{\tocentry{#1}{}{#3}{#4}} % Sections. -\def\numsecentry#1#2#3#4{\dosecentry{#1}{#2}{#4}} - \def\numsecentry#1#2#3#4{% \retrievesecnowidth\secnowidthsec{#2}% - \dosecentry{#1}{#2}{#4}% + \dosecentry{#1}{#2}{#3}{#4}% } \let\appsecentry=\numsecentry \def\unnsecentry#1#2#3#4{% \retrievesecnowidth\secnowidthsec{#2}% - \dosecentry{#1}{}{#4}% + \dosecentry{#1}{}{#3}{#4}% } % Subsections. \def\numsubsecentry#1#2#3#4{% \retrievesecnowidth\secnowidthssec{#2}% - \dosubsecentry{#1}{#2}{#4}% + \dosubsecentry{#1}{#2}{#3}{#4}% } \let\appsubsecentry=\numsubsecentry \def\unnsubsecentry#1#2#3#4{% \retrievesecnowidth\secnowidthssec{#2}% - \dosubsecentry{#1}{}{#4}% + \dosubsecentry{#1}{}{#3}{#4}% } % And subsubsections. -\def\numsubsubsecentry#1#2#3#4{\dosubsubsecentry{#1}{#2}{#4}} +\def\numsubsubsecentry#1#2#3#4{\dosubsubsecentry{#1}{#2}{#3}{#4}} \let\appsubsubsecentry=\numsubsubsecentry -\def\unnsubsubsecentry#1#2#3#4{\dosubsubsecentry{#1}{}{#4}} +\def\unnsubsubsecentry#1#2#3#4{\dosubsubsecentry{#1}{}{#3}{#4}} % This parameter controls the indentation of the various levels. % Same as \defaultparindent. \newdimen\tocindent \tocindent = 15pt % Now for the actual typesetting. In all these, #1 is the text, #2 is -% a section number if present, and #3 is the page number. +% a section number if present, #3 is the node, and #4 is the page number. % % If the toc has to be broken over pages, we want it to be at chapters % if at all possible; hence the \penalty. -\def\dochapentry#1#2#3{% - \penalty-300 \vskip1\baselineskip plus.33\baselineskip minus.25\baselineskip +\def\dochapentry#1#2#3#4{% + \ifafterpartentry + \afterpartentryfalse + \penalty5000 + \else + \penalty-300 + \fi + \vskip1\baselineskip plus.33\baselineskip minus.25\baselineskip \begingroup % Move the page numbers slightly to the right \advance\entryrightmargin by -0.05em \chapentryfonts \extrasecnoskip=0.4em % separate chapter number more - \tocentry{#1}{#2}{#3}% + \tocentry{#1}{#2}{#3}{#4}% \endgroup \nobreak\vskip .25\baselineskip plus.1\baselineskip } -\def\dosecentry#1#2#3{\begingroup +\def\dosecentry#1#2#3#4{\begingroup \secnowidth=\secnowidthchap \secentryfonts \leftskip=\tocindent - \tocentry{#1}{#2}{#3}% + \tocentry{#1}{#2}{#3}{#4}% \endgroup} -\def\dosubsecentry#1#2#3{\begingroup +\def\dosubsecentry#1#2#3#4{\begingroup \secnowidth=\secnowidthsec \subsecentryfonts \leftskip=2\tocindent - \tocentry{#1}{#2}{#3}% + \tocentry{#1}{#2}{#3}{#4}% \endgroup} -\def\dosubsubsecentry#1#2#3{\begingroup +\def\dosubsubsecentry#1#2#3#4{\begingroup \secnowidth=\secnowidthssec \subsubsecentryfonts \leftskip=3\tocindent - \tocentry{#1}{#2}{#3}% + \tocentry{#1}{#2}{#3}{#4}% \endgroup} % Used for the maximum width of a section number so we can align @@ -7005,12 +7289,16 @@ \newdimen\extrasecnoskip \extrasecnoskip=0pt -% \tocentry{TITLE}{SEC NO}{PAGE} +\let\tocnodetarget\empty +\let\entrypagetarget\empty + +% \tocentry{TITLE}{SEC NO}{NODE}{PAGE} % -\def\tocentry#1#2#3{% +\def\tocentry#1#2#3#4{% + \def\tocnodetarget{#3}% \def\secno{#2}% \ifx\empty\secno - \entry{#1}{#3}% + \entryinternal{#1}{#4}% \else \ifdim 0pt=\secnowidth \setbox0=\hbox{#2\hskip\labelspace\hskip\extrasecnoskip}% @@ -7021,7 +7309,7 @@ #2\hskip\labelspace\hskip\extrasecnoskip\hfill}% \fi \entrycontskip=\wd0 - \entry{\box0 #1}{#3}% + \entryinternal{\box0 #1}{#4}% \fi } \newdimen\labelspace @@ -7594,6 +7882,7 @@ {\catcode`\ =\other \gdef\docopying#1@end copying{\endgroup\def\copyingtext{#1}} } +\let\copyingtext\relax \def\insertcopying{% \begingroup @@ -7602,6 +7891,18 @@ \endgroup } +\def\publication{\checkenv{}\begingroup\macrobodyctxt\dopublication} +{\catcode`\ =\other +\gdef\dopublication#1@end publication{\endgroup\def\publicationtext{#1}} +} +\let\publicationtext\relax + +\def\insertpublication{% + \begingroup + \parindent = 0pt % paragraph indentation looks wrong on title page + \scanexp\publicationtext + \endgroup +} \message{defuns,} % @defun etc. @@ -7901,7 +8202,7 @@ {\rm\enskip}% hskip 0.5 em of \rmfont }{}% % - \boldbrax + \parenbrackglyphs % arguments will be output next, if any. } @@ -7911,7 +8212,10 @@ \def\^^M{}% for line continuation \df \ifdoingtypefn \tt \else \sl \fi \ifflagclear{txicodevaristt}{}% - {\def\var##1{{\setregularquotes \ttsl ##1}}}% + % use \ttsl for @var in both @def* and @deftype*. + % the kern prevents an italic correction at end, which appears + % too much for ttsl. + {\def\var##1{{\setregularquotes \ttsl ##1\kern 0pt }}}% #1% \egroup } @@ -7928,8 +8232,9 @@ \let\lparen = ( \let\rparen = ) % Be sure that we always have a definition for `(', etc. For example, -% if the fn name has parens in it, \boldbrax will not be in effect yet, -% so TeX would otherwise complain about undefined control sequence. +% if the fn name has parens in it, \parenbrackglyphs will not be in +% effect yet, so TeX would otherwise complain about undefined control +% sequence. { \activeparens \gdef\defcharsdefault{% @@ -7939,49 +8244,28 @@ } \globaldefs=1 \defcharsdefault - \gdef\boldbrax{\let(=\opnr\let)=\clnr\let[=\lbrb\let]=\rbrb} + \gdef\parenbrackglyphs{\let(=\opnr\let)=\cpnr\let[=\lbrb\let]=\rbrb} \gdef\magicamp{\let&=\amprm} } \let\ampchar\& -\newcount\parencount - -% If we encounter &foo, then turn on ()-hacking afterwards -\newif\ifampseen -\def\amprm#1 {\ampseentrue{\rm\ }} - -\def\parenfont{% - \ifampseen - % At the first level, print parens in roman, - % otherwise use the default font. - \ifnum \parencount=1 \rm \fi - \else - % The \sf parens (in \boldbrax) actually are a little bolder than - % the contained text. This is especially needed for [ and ] . - \sf - \fi -} -\def\infirstlevel#1{% - \ifampseen - \ifnum\parencount=1 - #1% - \fi - \fi -} -\def\bfafterword#1 {#1 \bf} +\def\amprm#1 {{\rm\ }} +\newcount\parencount +% opening and closing parentheses in roman font \def\opnr{% + \ptexslash % italic correction \global\advance\parencount by 1 - {\parenfont(}% - \infirstlevel \bfafterword + {\sf(}% } -\def\clnr{% - {\parenfont)}% - \infirstlevel \sl +\def\cpnr{% + \ptexslash % italic correction + {\sf)}% \global\advance\parencount by -1 } \newcount\brackcount +% left and right square brackets in bold font \def\lbrb{% \global\advance\brackcount by 1 {\bf[}% @@ -8023,18 +8307,11 @@ } \fi -\let\E=\expandafter - % Used at the time of macro expansion. % Argument is macro body with arguments substituted \def\scanmacro#1{% \newlinechar`\^^M - % expand the expansion of \eatleadingcr twice to maybe remove a leading - % newline (and \else and \fi tokens), then call \eatspaces on the result. - \def\xeatspaces##1{% - \E\E\E\E\E\E\E\eatspaces\E\E\E\E\E\E\E{\eatleadingcr##1% - }}% - \def\xempty##1{}% + \def\xeatspaces##1{\eatleadingcrthen\eatspaces{##1}}% % % Process the macro body under the current catcode regime. \scantokens{#1@comment}% @@ -8087,10 +8364,12 @@ \unbrace{\gdef\trim@@@ #1 } #2@{#1} } -{\catcode`\^^M=\other% -\gdef\eatleadingcr#1{\if\noexpand#1\noexpand^^M\else\E#1\fi}}% -% Warning: this won't work for a delimited argument -% or for an empty argument +% Trim a single leading ^^M off a string, then call #1 +{\catcode`\^^M=\active \catcode`\Q=3% +\gdef\eatleadingcrthen #1#2{\eatlcra #1Q#2Q^^MQ}% +\gdef\eatlcra #1#2Q^^M{\eatlcrb #1#2Q}% +\gdef\eatlcrb #1Q#2Q#3Q{#1{#2}}% +} % Trim a single trailing ^^M off a string. {\catcode`\^^M=\other \catcode`\Q=3% @@ -8226,6 +8505,10 @@ % is #, then the preceding argument is delimited by % an opening brace, and that opening brace is not consumed. +% Make @ a letter, so that we can make private-to-Texinfo macro names. +\edef\texiatcatcode{\the\catcode`\@} +\catcode `@=11\relax + % Parse the optional {params} list to @macro or @rmacro. % Set \paramno to the number of arguments, % and \paramlist to a parameter text for the macro (e.g. #1,#2,#3 for a @@ -8238,14 +8521,13 @@ % That gets used by \mbodybackslash (above). % % If there are 10 or more arguments, a different technique is used: see -% \parsemmanyargdef. +% \parsemmanyargdef@@. % \def\parsemargdef#1;{% \paramno=0\def\paramlist{}% \let\hash\relax % \hash is redefined to `#' later to get it into definitions \let\xeatspaces\relax - \let\xempty\relax \parsemargdefxxx#1,;,% \ifnum\paramno<10\relax\else \paramno0\relax @@ -8257,11 +8539,9 @@ \else \let\next=\parsemargdefxxx \advance\paramno by 1 \expandafter\edef\csname macarg.\eatspaces{#1}\endcsname - {\xeatspaces{\hash\the\paramno\noexpand\xempty{}}}% + {\xeatspaces{\hash\the\paramno}}% \edef\paramlist{\paramlist\hash\the\paramno,}% \fi\next} -% the \xempty{} is to give \eatleadingcr an argument in the case of an -% empty macro argument. % \parsemacbody, \parsermacbody % @@ -8272,14 +8552,12 @@ % body to be transformed. % Set \macrobody to the body of the macro, and call \macrodef. % +\catcode `\@\texiatcatcode {\catcode`\ =\other\long\gdef\parsemacbody#1@end macro{% \xdef\macrobody{\eatcr{#1}}\endgroup\macrodef}}% {\catcode`\ =\other\long\gdef\parsermacbody#1@end rmacro{% \xdef\macrobody{\eatcr{#1}}\endgroup\macrodef}}% - -% Make @ a letter, so that we can make private-to-Texinfo macro names. -\edef\texiatcatcode{\the\catcode`\@} -\catcode `@=11\relax +\catcode `\@=11\relax %%%%%%%%%%%%%% Code for > 10 arguments only %%%%%%%%%%%%%%%%%% @@ -8511,7 +8789,7 @@ \expandafter\xdef\csname\the\macname\endcsname{% \begingroup \noexpand\spaceisspace - \noexpand\endlineisspace + \noexpand\ignoreactivenewline \noexpand\expandafter % skip any whitespace after the macro name. \expandafter\noexpand\csname\the\macname @@@\endcsname}% \expandafter\xdef\csname\the\macname @@@\endcsname{% @@ -8540,15 +8818,13 @@ \noexpand\expandafter \expandafter\noexpand\csname\the\macname @@\endcsname}% \expandafter\xdef\csname\the\macname @@\endcsname##1{% - \noexpand\passargtomacro - \expandafter\noexpand\csname\the\macname @@@\endcsname{##1,}}% + \noexpand\passargtomacro + \expandafter\noexpand\csname\the\macname @@@\endcsname{##1,}}% \expandafter\xdef\csname\the\macname @@@\endcsname##1{% - \expandafter\noexpand\csname\the\macname @@@@\endcsname ##1}% - \expandafter\expandafter - \expandafter\xdef - \expandafter\expandafter - \csname\the\macname @@@@\endcsname\paramlist{% - \endgroup\noexpand\scanmacro{\macrobody}}% + \expandafter\noexpand\csname\the\macname @@@@\endcsname ##1}% + \expandaftergroup{\expandafter\xdef\csname\the\macname @@@@\endcsname}% + \paramlist{% + \endgroup\noexpand\scanmacro{\macrobody}}% \else % 10 or more: \expandafter\xdef\csname\the\macname\endcsname{% \noexpand\getargvals@{\the\macname}{\argl}% @@ -8560,6 +8836,16 @@ \catcode `\@\texiatcatcode\relax % end private-to-Texinfo catcodes +% utility definition to avoid excessive use of \expandafter. call +% as \expandaftergroup{CONTENT}\WORD to expand \WORD exactly once and remove +% braces around CONTENT. +\def\expandaftergroup#1#2{% + \expandafter\expandaftergroupx\expandafter{#2}{#1}% +} +\def\expandaftergroupx#1#2{% + #2#1% +} + \def\norecurse#1{\bgroup\cslet{#1}{macsave.#1}} @@ -8729,9 +9015,8 @@ \expandafter\noexpand \csname\the\macname @@@\endcsname##1\noexpand\endlinemacro } - \expandafter\expandafter - \expandafter\xdef - \expandafter\expandafter\csname\the\macname @@@\endcsname\paramlist{% + \expandaftergroup{\expandafter\xdef\csname\the\macname @@@\endcsname}% + \paramlist{% \newlinechar=13 % split \macrobody into lines \noexpand\scantokens{\macrobody}% } @@ -8806,14 +9091,19 @@ \let\lastnode=\empty % Write a cross-reference definition for the current node. #1 is the -% type (Ynumbered, Yappendix, Ynothing). +% type (Ynumbered, Yappendix, Ynothing). #2 is the section title. % -\def\donoderef#1{% +\def\donoderef#1#2{% \ifx\lastnode\empty\else - \setref{\lastnode}{#1}% + \setref{\lastnode}{#1}{#2}% \global\let\lastnode=\empty + \setnodeseenonce \fi } +\def\setnodeseenonce{ + \global\nodeseentrue + \let\setnodeseenonce\relax +} % @nodedescription, @nodedescriptionblock - do nothing for TeX \parseargdef\nodedescription{} @@ -8826,21 +9116,28 @@ % \def\savesf{\relax \ifhmode \savesfregister=\spacefactor \fi} \def\restoresf{\relax \ifhmode \spacefactor=\savesfregister \fi} -\def\anchor#1{\savesf \setref{#1}{Ynothing}\restoresf \ignorespaces} - -% \setref{NAME}{SNT} defines a cross-reference point NAME (a node or an -% anchor), which consists of three parts: -% 1) NAME-title - the current sectioning name taken from \currentsection, -% or the anchor name. -% 2) NAME-snt - section number and type, passed as the SNT arg, or -% empty for anchors. +\def\anchor#1{% + \savesf \setref{#1}{Yanchor}{#1}\restoresf \ignorespaces +} + +% @namedanchor{NAME, XREFNAME} -- define xref target at arbitrary point +% with label text for cross-references to it. +\def\namedanchor#1{\donamedanchor#1\finish}% +\def\donamedanchor#1,#2\finish{% + \savesf \setref{#1}{Yanchor}{\ignorespaces #2\unskip}\restoresf \ignorespaces +} + +% \setref{NAME}{SNT}{TITLE} defines a cross-reference point NAME (a node +% or an anchor), which consists of three parts: +% 1) NAME-title - the current sectioning name +% 2) NAME-snt - section number and type, passed as the SNT arg. % 3) NAME-pg - the page number. % % This is called from \donoderef, \anchor, and \dofloat. In the case of % floats, there is an additional part, which is not written here: % 4) NAME-lof - the text as it should appear in a @listoffloats. % -\def\setref#1#2{% +\def\setref#1#2#3{% \pdfmkdest{#1}% \iflinks {% @@ -8852,7 +9149,7 @@ \write\auxfile{@xrdef{#1-% #1 of \setref, expanded by the \edef ##1}{##2}}% these are parameters of \writexrdef }% - \toks0 = \expandafter{\currentsection}% + \toks0 = {#3}% \immediate \writexrdef{title}{\the\toks0 }% \immediate \writexrdef{snt}{\csname #2\endcsname}% \Ynumbered etc. \safewhatsit{\writexrdef{pg}{\folio}}% will be written later, at \shipout @@ -8906,15 +9203,7 @@ \setbox\infofilenamebox = \hbox{\infofilename\unskip}% % \startxreflink{#1}{#4}% - {% - % Have to otherify everything special to allow the \csname to - % include an _ in the xref name, etc. - \indexnofonts - \turnoffactive - \def\value##1{##1}% - \expandafter\global\expandafter\let\expandafter\Xthisreftitle - \csname XR#1-title\endcsname - }% + \getrefx{#1-title}\Xthisreftitle % % Float references are printed completely differently: "Figure 1.2" % instead of "[somenode], p.3". \iffloat distinguishes them by @@ -8947,21 +9236,23 @@ % Cross-manual reference with a printed manual name. % \crossmanualxref{\cite{\printedmanual\unskip}}% - % \else\ifdim \wd\infofilenamebox > 0pt % Cross-manual reference with only an info filename (arg 4), no % printed manual name (arg 5). This is essentially the same as % the case above; we output the filename, since we have nothing else. % \crossmanualxref{\code{\infofilename\unskip}}% - % \else % Reference within this manual. % - % Only output a following space if the -snt ref is nonempty, as the ref - % will be empty for @unnumbered and @anchor. - \setbox2 = \hbox{\ignorespaces \refx{#1-snt}}% - \ifdim \wd2 > 0pt \refx{#1-snt}\space\fi + % Only output a following space if the -snt ref is nonempty, as is + % the case for @unnumbered and @anchor. + \getrefx{#1-snt}\tmp + \ifx\tmp\empty\else + \ifx\tmp\Yanchor\else + \tmp\space + \fi + \fi % % output the `[mynode]' via the macro below so it can be overridden. \xrefprintnodename\printedrefname @@ -9017,7 +9308,7 @@ \else % Otherwise just copy the Info node name. \def\printedrefname{\ignorespaces #1}% - \fi% + \fi \fi \fi \fi @@ -9049,7 +9340,7 @@ \ifnum\filenamelength>0 goto file{\the\filename.pdf} name{\pdfdestname}% \else - goto name{\pdfmkpgn{\pdfdestname}}% + goto name{\pdfdestname}% \fi \else % XeTeX \ifnum\filenamelength>0 @@ -9129,6 +9420,7 @@ % \def\Ynothing{} \def\Yomitfromtoc{} +\def\Yanchor{\isanchor} \let\isanchor\relax \def\Ynumbered{% \ifnum\secno=0 \putwordChapter@tie \the\chapno @@ -9155,14 +9447,7 @@ % \refx{NAME} - reference a cross-reference string named NAME. \def\refx#1{% - \requireauxfile - {% - \indexnofonts - \turnoffactive - \def\value##1{##1}% - \expandafter\global\expandafter\let\expandafter\thisrefX - \csname XR#1\endcsname - }% + \getrefx{#1}\thisrefX \ifx\thisrefX\relax % If not defined, say something at least. \angleleft un\-de\-fined\angleright @@ -9183,6 +9468,17 @@ \fi } +% Set #2 to xref string #1 +\def\getrefx#1#2{% + \requireauxfile + {% + \indexnofonts + \turnoffactive + \def\value##1{##1}% + \expandafter\global\expandafter\let\expandafter#2\csname XR#1\endcsname + }% +} + % This is the macro invoked by entries in the aux file. Define a control % sequence for a cross-reference target (we prepend XR to the control sequence % name to avoid collisions). The value is the page number. If this is a float @@ -9225,6 +9521,7 @@ \expandafter\xdef\csname floatlist\iffloattype\endcsname{\the\toks0 {\safexrefname}}% \fi + \ignorespaces % ignore ends of line in aux file } % If working on a large document in chapters, it is convenient to @@ -9247,12 +9544,14 @@ % Read the last existing aux file, if any. No error if none exists. % \def\tryauxfile{% + \ifxetex\xetexpreauxfile\fi \openin 1 \jobname.aux \ifeof 1 \else \readdatafile{aux}% \global\havexrefstrue \fi \closein 1 + \ifxetex\xetexpostauxfile\fi } \def\setupdatafile{% @@ -9551,7 +9850,9 @@ % For pdfTeX and LuaTeX <= 0.80 \dopdfimage{#1}{#2}{#3}% \else - \ifx\XeTeXrevision\thisisundefined + \ifxetex + \doxeteximage{#1}{#2}{#3}% + \else % For epsf.tex % \epsfbox itself resets \epsf?size at each figure. \setbox0 = \hbox{\ignorespaces #2}% @@ -9559,9 +9860,6 @@ \setbox0 = \hbox{\ignorespaces #3}% \ifdim\wd0 > 0pt \epsfysize=#3\relax \fi \epsfbox{#1.eps}% - \else - % For XeTeX - \doxeteximage{#1}{#2}{#3}% \fi \fi % @@ -9639,14 +9937,15 @@ \global\advance\floatno by 1 % {% - % This magic value for \currentsection is output by \setref as the - % XREFLABEL-title value. \xrefX uses it to distinguish float + % This magic value for the third argument of \setref is output as + % the XREFLABEL-title value. \xrefX uses it to distinguish float % labels (which have a completely different output format) from % node and anchor labels. And \xrdef uses it to construct the % lists of floats. % - \edef\currentsection{\floatmagic=\safefloattype}% - \setref{\floatlabel}{Yfloat}% + \edef\tmp{\noexpand\setref{\floatlabel}{Yfloat}% + {\floatmagic=\safefloattype}}% + \tmp }% \fi % @@ -9768,7 +10067,7 @@ % #1 is the control sequence we are passed; we expand into a conditional % which is true if #1 represents a float ref. That is, the magic -% \currentsection value which we \setref above. +% value which we passed to \setref above. % \def\iffloat#1{\expandafter\doiffloat#1==\finish} % @@ -9825,6 +10124,7 @@ \toksA = \expandafter{\csname XR#1-lof\endcsname}% % % use the same \entry macro we use to generate the TOC and index. + \let\entry\entryinternal \edef\writeentry{\noexpand\entry{\the\toksA}{\csname XR#1-pg\endcsname}}% \writeentry }} @@ -9860,8 +10160,18 @@ \gdef\documentlanguagetrywithoutunderscore#1_#2\finish{% \openin 1 txi-#1.tex \ifeof 1 - \errhelp = \nolanghelp - \errmessage{Cannot read language file txi-#1.tex}% + \def\lang{#1}% + \def\enword{en}% + \ifx\lang\enword + % for English only, keep on going rather than issuing a fatal error + % message, as txi-en.tex likely doesn't contain any changes from the + % defaults. note that this is a problem if we already loaded another + % language file and want to switch back to English. + \message{Cannot read language file txi-#1.tex}% + \else + \errhelp = \nolanghelp + \errmessage{Cannot read language file txi-#1.tex}% + \fi \else \globaldefs = 1 % everything in the txi-LL files needs to persist \input txi-#1.tex @@ -9907,35 +10217,40 @@ \newif\iftxinativeunicodecapable \newif\iftxiusebytewiseio -\ifx\XeTeXrevision\thisisundefined - \ifx\luatexversion\thisisundefined - \txinativeunicodecapablefalse - \txiusebytewiseiotrue - \else +\ifxetex + \txinativeunicodecapabletrue + \txiusebytewiseiofalse +\else + \ifluatex \txinativeunicodecapabletrue \txiusebytewiseiofalse + \else + \txinativeunicodecapablefalse + \txiusebytewiseiotrue \fi -\else - \txinativeunicodecapabletrue - \txiusebytewiseiofalse \fi +\let\xetexpreauxfile\relax +\let\xetexpostauxfile\relax + % Set I/O by bytes instead of UTF-8 sequence for XeTeX and LuaTex % for non-UTF-8 (byte-wise) encodings. % \def\setbytewiseio{% - \ifx\XeTeXrevision\thisisundefined - \else - \XeTeXdefaultencoding "bytes" % For subsequent files to be read - \XeTeXinputencoding "bytes" % For document root file - % Unfortunately, there seems to be no corresponding XeTeX command for - % output encoding. This is a problem for auxiliary index and TOC files. - % The only solution would be perhaps to write out @U{...} sequences in - % place of non-ASCII characters. + \ifxetex + % For document root file + \XeTeXinputencoding "bytes" + % + % Setting for subsequent files to be read with @include. + \XeTeXdefaultencoding "bytes" + % + % Use UTF-8 for reading auxiliary index and TOC files, which are + % always output in UTF-8 with XeTeX. + \def\xetexpreauxfile{\XeTeXdefaultencoding "UTF-8"}% + \def\xetexpostauxfile{\XeTeXdefaultencoding "bytes"}% \fi - \ifx\luatexversion\thisisundefined - \else + \ifluatex \directlua{ local utf8_char, byte, gsub = unicode.utf8.char, string.byte, string.gsub local function convert_char (char) @@ -10044,8 +10359,7 @@ \fi % lattwo \fi % ascii % - \ifx\XeTeXrevision\thisisundefined - \else + \ifxetex \ifx \declaredencoding \utfeight \else \ifx \declaredencoding \ascii @@ -10328,11 +10642,15 @@ \gdef\UTFviiiDefined#1{% \ifx #1\relax - \message{\linenumber Unicode char \string #1 not defined for Texinfo}% + \ifutfviiidefinedwarning + \message{\linenumber Unicode char \string #1 not defined for Texinfo}% + \fi \else \expandafter #1% \fi } +\newif\ifutfviiidefinedwarning +\utfviiidefinedwarningtrue % Give non-ASCII bytes the active definitions for processing UTF-8 sequences \begingroup @@ -10342,8 +10660,8 @@ % Loop from \countUTFx to \countUTFy, performing \UTFviiiTmp % substituting ~ and $ with a character token of that value. - \def\UTFviiiLoop{% - \global\catcode\countUTFx\active + \gdef\UTFviiiLoop{% + \catcode\countUTFx\active \uccode`\~\countUTFx \uccode`\$\countUTFx \uppercase\expandafter{\UTFviiiTmp}% @@ -10351,7 +10669,7 @@ \ifnum\countUTFx < \countUTFy \expandafter\UTFviiiLoop \fi} - + % % For bytes other than the first in a UTF-8 sequence. Not expected to % be expanded except when writing to auxiliary files. \countUTFx = "80 @@ -10385,6 +10703,16 @@ \else\expandafter\UTFviiiFourOctets\expandafter$\fi }}% \UTFviiiLoop + % + % for pdftex only, used to expand ASCII to UTF-16BE. + \gdef\asciitounicode{% + \countUTFx = "20 + \countUTFy = "80 + \def\UTFviiiTmp{% + \def~{\nullbyte $}}% + \UTFviiiLoop + } + {\catcode0=11 \gdef\nullbyte{^^00}}% \endgroup \def\globallet{\global\let} % save some \expandafter's below @@ -10409,8 +10737,8 @@ \fi } -% These macros are used here to construct the name of a control -% sequence to be defined. +% These macros are used here to construct the names of macros +% that expand to the definitions for UTF-8 sequences. \def\UTFviiiTwoOctetsName#1#2{% \csname u8:#1\string #2\endcsname}% \def\UTFviiiThreeOctetsName#1#2#3{% @@ -10418,6 +10746,35 @@ \def\UTFviiiFourOctetsName#1#2#3#4{% \csname u8:#1\string #2\string #3\string #4\endcsname}% +% generate UTF-16 from codepoint +\def\utfsixteentotoks#1#2{% + \countUTFz = "#2\relax + \ifnum \countUTFz > 65535 + % doesn't work for codepoints > U+FFFF + % we don't define glyphs for any of these anyway, so it doesn't matter + #1={U+#2}% + \else + \countUTFx = \countUTFz + \divide\countUTFx by 256 + \countUTFy = \countUTFx + \multiply\countUTFx by 256 + \advance\countUTFz by -\countUTFx + \uccode`,=\countUTFy + \uccode`;=\countUTFz + \ifnum\countUTFy = 0 + \uppercase{#1={\nullbyte\string;}}% + \else\ifnum\countUTFz = 0 + \uppercase{#1={\string,\nullbyte}}% + \else + \uppercase{#1={\string,\string;}}% + \fi\fi + % NB \uppercase cannot insert a null byte + \fi +} + +\newif\ifutfbytespdf +\utfbytespdffalse + % For UTF-8 byte sequences (TeX, e-TeX and pdfTeX), % provide a definition macro to replace a Unicode character; % this gets used by the @U command @@ -10434,18 +10791,22 @@ \countUTFz = "#1\relax \begingroup \parseXMLCharref - - % Give \u8:... its definition. The sequence of seven \expandafter's - % expands after the \gdef three times, e.g. % + % Completely expand \UTFviiiTmp, which looks like: % 1. \UTFviiTwoOctetsName B1 B2 % 2. \csname u8:B1 \string B2 \endcsname % 3. \u8: B1 B2 (a single control sequence token) + \xdef\UTFviiiTmp{\UTFviiiTmp}% % - \expandafter\expandafter - \expandafter\expandafter - \expandafter\expandafter - \expandafter\gdef \UTFviiiTmp{#2}% + \ifpdf + \toksA={#2}% + \utfsixteentotoks\toksB{#1}% + \expandafter\xdef\UTFviiiTmp{% + \noexpand\ifutfbytespdf\noexpand\utfbytes{\the\toksB}% + \noexpand\else\the\toksA\noexpand\fi}% + \else + \expandafter\gdef\UTFviiiTmp{#2}% + \fi % \expandafter\ifx\csname uni:#1\endcsname \relax \else \message{Internal error, already defined: #1}% @@ -10455,8 +10816,9 @@ \expandafter\globallet\csname uni:#1\endcsname \UTFviiiTmp \endgroup} % - % Given the value in \countUTFz as a Unicode code point, set \UTFviiiTmp - % to the corresponding UTF-8 sequence. + % Given the value in \countUTFz as a Unicode code point, set + % \UTFviiiTmp to one of the \UTVviii*OctetsName macros followed by + % the corresponding UTF-8 sequence. \gdef\parseXMLCharref{% \ifnum\countUTFz < "20\relax \errhelp = \EMsimple @@ -10515,6 +10877,16 @@ \catcode"#1=\other } +% Suppress ligature creation from adjacent characters. +\ifluatex + % Braces do not suppress ligature creation in LuaTeX, e.g. in of{}fice + % to suppress the "ff" ligature. Using a kern appears to be the only + % workaround. + \def\nolig{\kern0pt{}} +\else + \def\nolig{{}} +\fi + % https://en.wikipedia.org/wiki/Plane_(Unicode)#Basic_M % U+0000..U+007F = https://en.wikipedia.org/wiki/Basic_Latin_(Unicode_block) % U+0080..U+00FF = https://en.wikipedia.org/wiki/Latin-1_Supplement_(Unicode_block) @@ -11132,8 +11504,8 @@ % Punctuation \DeclareUnicodeCharacter{2013}{--}% \DeclareUnicodeCharacter{2014}{---}% - \DeclareUnicodeCharacter{2018}{\quoteleft{}}% - \DeclareUnicodeCharacter{2019}{\quoteright{}}% + \DeclareUnicodeCharacter{2018}{\quoteleft\nolig}% + \DeclareUnicodeCharacter{2019}{\quoteright\nolig}% \DeclareUnicodeCharacter{201A}{\quotesinglbase{}}% \DeclareUnicodeCharacter{201C}{\quotedblleft{}}% \DeclareUnicodeCharacter{201D}{\quotedblright{}}% @@ -11168,7 +11540,7 @@ \DeclareUnicodeCharacter{2287}{\ensuremath\supseteq}% % \DeclareUnicodeCharacter{2016}{\ensuremath\Vert}% - \DeclareUnicodeCharacter{2032}{\ensuremath\prime}% + \DeclareUnicodeCharacter{2032}{\ensuremath{^\prime}}% \DeclareUnicodeCharacter{210F}{\ensuremath\hbar}% \DeclareUnicodeCharacter{2111}{\ensuremath\Im}% \DeclareUnicodeCharacter{2113}{\ensuremath\ell}% @@ -11291,6 +11663,25 @@ % \global\mathchardef\checkmark="1370% actually the square root sign \DeclareUnicodeCharacter{2713}{\ensuremath\checkmark}% + % + % These are all the combining accents. We need these empty definitions + % at present for the sake of PDF outlines. + \DeclareUnicodeCharacter{0300}{}% + \DeclareUnicodeCharacter{0301}{}% + \DeclareUnicodeCharacter{0302}{}% + \DeclareUnicodeCharacter{0303}{}% + \DeclareUnicodeCharacter{0305}{}% + \DeclareUnicodeCharacter{0306}{}% + \DeclareUnicodeCharacter{0307}{}% + \DeclareUnicodeCharacter{0308}{}% + \DeclareUnicodeCharacter{030A}{}% + \DeclareUnicodeCharacter{030B}{}% + \DeclareUnicodeCharacter{030C}{}% + \DeclareUnicodeCharacter{0323}{}% + \DeclareUnicodeCharacter{0327}{}% + \DeclareUnicodeCharacter{0328}{}% + \DeclareUnicodeCharacter{0331}{}% + \DeclareUnicodeCharacter{0361}{}% }% end of \unicodechardefs % UTF-8 byte sequence (pdfTeX) definitions (replacing and @U command) @@ -11429,12 +11820,12 @@ \pdfhorigin = 1 true in \pdfvorigin = 1 true in \else - \ifx\XeTeXrevision\thisisundefined - \special{papersize=#8,#7}% - \else + \ifxetex \pdfpageheight #7\relax \pdfpagewidth #8\relax % XeTeX does not have \pdfhorigin and \pdfvorigin. + \else + \special{papersize=#8,#7}% \fi \fi % @@ -11634,21 +12025,21 @@ #1#2#3=\countB\relax } -\ifx\XeTeXrevision\thisisundefined - \ifx\luatexversion\thisisundefined +\ifxetex % XeTeX + \mtsetprotcode\textrm + \def\mtfontexpand#1{} +\else + \ifluatex % LuaTeX + \mtsetprotcode\textrm + \def\mtfontexpand#1{\expandglyphsinfont#1 20 20 1\relax} + \else \ifpdf % pdfTeX \mtsetprotcode\textrm \def\mtfontexpand#1{\pdffontexpand#1 20 20 1 autoexpand\relax} \else % TeX \def\mtfontexpand#1{} \fi - \else % LuaTeX - \mtsetprotcode\textrm - \def\mtfontexpand#1{\expandglyphsinfont#1 20 20 1\relax} \fi -\else % XeTeX - \mtsetprotcode\textrm - \def\mtfontexpand#1{} \fi @@ -11657,18 +12048,18 @@ \def\microtypeON{% \microtypetrue % - \ifx\XeTeXrevision\thisisundefined - \ifx\luatexversion\thisisundefined + \ifxetex % XeTeX + \XeTeXprotrudechars=2 + \else + \ifluatex % LuaTeX + \adjustspacing=2 + \protrudechars=2 + \else \ifpdf % pdfTeX \pdfadjustspacing=2 \pdfprotrudechars=2 \fi - \else % LuaTeX - \adjustspacing=2 - \protrudechars=2 \fi - \else % XeTeX - \XeTeXprotrudechars=2 \fi % \mtfontexpand\textrm @@ -11679,18 +12070,18 @@ \def\microtypeOFF{% \microtypefalse % - \ifx\XeTeXrevision\thisisundefined - \ifx\luatexversion\thisisundefined + \ifxetex % XeTeX + \XeTeXprotrudechars=0 + \else + \ifluatex % LuaTeX + \adjustspacing=0 + \protrudechars=0 + \else \ifpdf % pdfTeX \pdfadjustspacing=0 \pdfprotrudechars=0 \fi - \else % LuaTeX - \adjustspacing=0 - \protrudechars=0 \fi - \else % XeTeX - \XeTeXprotrudechars=0 \fi } diff --git a/cobc/ChangeLog b/cobc/ChangeLog index e9b967611..ea848200d 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,4 +1,16 @@ +2025-07-28 David Declerck + + * codegen.c (output_module_init_function): replace "module" by + "module__" to avoid name clashes with COBOL programs named "module" + +2025-07-28 Simon Sobisch + + * cobc.c (process_command_line): only add -O0 to command line for -g + if COB_DEBUG_FLAGS is not defined - because if it is needed, then + this should be seen and setup by configure + * parser.y: fixed enum for C89 support + 2025-07-15 Simon Sobisch * cobc.h, tree.h, replace.c, scanner.l: fixed enum and forward definitions diff --git a/cobc/Makefile.am b/cobc/Makefile.am index c3f696fa0..d061a5b75 100644 --- a/cobc/Makefile.am +++ b/cobc/Makefile.am @@ -49,7 +49,7 @@ CLEANFILES = parser.output ppparse.output include $(top_srcdir)/aminclude_static.am clean-local: code-coverage-clean -dist-clean-local: code-coverage-dist-clean +distclean-local: code-coverage-dist-clean CODE_COVERAGE_BRANCH_COVERAGE=1 CODE_COVERAGE_LCOV_OPTIONS = --no-external diff --git a/cobc/cobc.c b/cobc/cobc.c index 146021452..5118bf5b5 100644 --- a/cobc/cobc.c +++ b/cobc/cobc.c @@ -296,7 +296,7 @@ static struct cobc_mem_struct *cobc_plexmem_base = NULL; static const char *cobc_cc; /* C compiler */ static char *cobc_cflags; /* C compiler flags */ #ifdef COB_DEBUG_FLAGS -static const char *cobc_debug_flags; /* C debgging flags */ +static const char *cobc_debug_flags; /* C debugging flags */ #else #ifndef _MSC_VER #error missing definition of COB_DEBUG_FLAGS @@ -3418,13 +3418,14 @@ process_command_line (const int argc, char **argv) #endif cb_flag_stack_check = 1; cb_flag_symbols = 1; -#ifdef COB_DEBUG_FLAGS +#ifdef COB_DEBUG_FLAGS /* may be hardcoded for some compilers */ COBC_ADD_STR (cobc_cflags, " ", cobc_debug_flags, NULL); -#endif +#else if (copt == NULL) { /* some compilers warn if not explicit passed, so default to -O0 for -g */ copt = CB_COPT_0; } +#endif break; case 'G': @@ -9151,7 +9152,7 @@ set_cobc_defaults (void) COBC_ADD_STR (cobc_ldflags, cob_relocate_string (COB_LDFLAGS), NULL, NULL); } -#ifdef COB_DEBUG_FLAGS +#ifdef COB_DEBUG_FLAGS /* may be hardcoded for some compilers */ p = cobc_getenv ("COB_DEBUG_FLAGS"); if (p && *p) { cobc_debug_flags = (const char *)p; diff --git a/cobc/codegen.c b/cobc/codegen.c index dcda45f5a..3b31affaf 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -12401,12 +12401,12 @@ output_module_init_function (struct cb_program *prog) if (!prog->nested_level) { output_line ("/* Initialize module structure for %s */", prog->orig_program_id); - output_line ("static void %s_module_init (cob_module *module)", + output_line ("static void %s_module_init (cob_module *module__)", prog->program_id); } else { output_line ("/* Initialize module structure for %s (nested %d) */", prog->program_id, prog->toplev_count); - output_line ("static void %s_%d_module_init (cob_module *module)", + output_line ("static void %s_%d_module_init (cob_module *module__)", prog->program_id, prog->toplev_count); } output_block_open (); @@ -12429,57 +12429,57 @@ output_module_init_function (struct cb_program *prog) recent_prog = prog; /* Do not initialize next pointer, parameter list pointer + count */ - output_line ("module->module_name = \"%s\";", prog->orig_program_id); - output_line ("module->module_formatted_date = COB_MODULE_FORMATTED_DATE;"); - output_line ("module->module_source = COB_SOURCE_FILE;"); - output_line ("module->gc_version = COB_PACKAGE_VERSION;"); + output_line ("module__->module_name = \"%s\";", prog->orig_program_id); + output_line ("module__->module_formatted_date = COB_MODULE_FORMATTED_DATE;"); + output_line ("module__->module_source = COB_SOURCE_FILE;"); + output_line ("module__->gc_version = COB_PACKAGE_VERSION;"); if (!prog->nested_level) { - output_line ("module->module_entry.funcptr = (void *(*)())%s;", + output_line ("module__->module_entry.funcptr = (void *(*)())%s;", prog->program_id); if (prog->prog_type == COB_MODULE_TYPE_FUNCTION) { - output_line ("module->module_cancel.funcptr = NULL;"); + output_line ("module__->module_cancel.funcptr = NULL;"); } else { - output_line ("module->module_cancel.funcptr = (void *(*)())%s_;", + output_line ("module__->module_cancel.funcptr = (void *(*)())%s_;", prog->program_id); } } else { - output_line ("module->module_entry.funcvoid = NULL;"); - output_line ("module->module_cancel.funcvoid = NULL;"); + output_line ("module__->module_entry.funcvoid = NULL;"); + output_line ("module__->module_cancel.funcvoid = NULL;"); } if (!cobc_flag_main && non_nested_count > 1) { - output_line ("module->module_ref_count = &cob_reference_count;"); + output_line ("module__->module_ref_count = &cob_reference_count;"); } else { - output_line ("module->module_ref_count = NULL;"); + output_line ("module__->module_ref_count = NULL;"); } - output_line ("module->module_path = &cob_module_path;"); - output_line ("module->module_active = 0;"); - output_line ("module->module_date = COB_MODULE_DATE;"); - output_line ("module->module_time = COB_MODULE_TIME;"); - output_line ("module->module_type = %u;", prog->prog_type); - output_line ("module->module_param_cnt = %u;", prog->num_proc_params); + output_line ("module__->module_path = &cob_module_path;"); + output_line ("module__->module_active = 0;"); + output_line ("module__->module_date = COB_MODULE_DATE;"); + output_line ("module__->module_time = COB_MODULE_TIME;"); + output_line ("module__->module_type = %u;", prog->prog_type); + output_line ("module__->module_param_cnt = %u;", prog->num_proc_params); #if 0 /* currently not checked anywhere, may use for void or more general type */ - output_line ("module->module_returning = %u;", prog->flag_void ? 0 : 1); + output_line ("module__->module_returning = %u;", prog->flag_void ? 0 : 1); #endif - output_line ("module->ebcdic_sign = %d;", cb_ebcdic_sign); - output_line ("module->decimal_point = '%c';", prog->decimal_point); - output_line ("module->currency_symbol = '%c';", prog->currency_symbol); - output_line ("module->numeric_separator = '%c';", prog->numeric_separator); - output_line ("module->flag_filename_mapping = %d;", cb_filename_mapping); - output_line ("module->flag_binary_truncate = %d;", cb_binary_truncate); - output_line ("module->flag_pretty_display = %d;", cb_pretty_display); - output_line ("module->flag_host_sign = %d;", cb_host_sign); - output_line ("module->flag_no_phys_canc = %d;", no_physical_cancel); - output_line ("module->flag_main = %d;", cobc_flag_main); - output_line ("module->flag_fold_call = %d;", cb_fold_call); - output_line ("module->flag_dialect = COB_DIALECT_%s;", cb_dialect); + output_line ("module__->ebcdic_sign = %d;", cb_ebcdic_sign); + output_line ("module__->decimal_point = '%c';", prog->decimal_point); + output_line ("module__->currency_symbol = '%c';", prog->currency_symbol); + output_line ("module__->numeric_separator = '%c';", prog->numeric_separator); + output_line ("module__->flag_filename_mapping = %d;", cb_filename_mapping); + output_line ("module__->flag_binary_truncate = %d;", cb_binary_truncate); + output_line ("module__->flag_pretty_display = %d;", cb_pretty_display); + output_line ("module__->flag_host_sign = %d;", cb_host_sign); + output_line ("module__->flag_no_phys_canc = %d;", no_physical_cancel); + output_line ("module__->flag_main = %d;", cobc_flag_main); + output_line ("module__->flag_fold_call = %d;", cb_fold_call); + output_line ("module__->flag_dialect = COB_DIALECT_%s;", cb_dialect); if (cb_mf_files && cb_std_define != CB_STD_85) { /* Not if cobol85 test suite */ - output_line ("module->flag_file_format = COB_FILE_IS_MF;"); + output_line ("module__->flag_file_format = COB_FILE_IS_MF;"); } else { - output_line ("module->flag_file_format = COB_FILE_IS_DFLT;"); + output_line ("module__->flag_file_format = COB_FILE_IS_DFLT;"); } - output_line ("module->flag_exit_program = 0;"); + output_line ("module__->flag_exit_program = 0;"); { int opt = 0; if (cb_flag_traceall) { @@ -12495,17 +12495,17 @@ output_module_init_function (struct cb_program *prog) opt |= COB_MODULE_DEBUG; } #endif - output_line ("module->flag_debug_trace |= %d;", opt); + output_line ("module__->flag_debug_trace |= %d;", opt); } - output_line ("module->flag_dump_sect = 0x%02X;", cb_flag_dump); - output_line ("module->flag_dump_ready = %u;", cb_flag_dump ? 1 : 0); - output_line ("module->xml_mode = %u;", cb_xml_parse_xmlss); - output_line ("module->module_stmt = 0;"); + output_line ("module__->flag_dump_sect = 0x%02X;", cb_flag_dump); + output_line ("module__->flag_dump_ready = %u;", cb_flag_dump ? 1 : 0); + output_line ("module__->xml_mode = %u;", cb_xml_parse_xmlss); + output_line ("module__->module_stmt = 0;"); if (source_cache) { - output_line ("module->module_sources = %ssource_files;", + output_line ("module__->module_sources = %ssource_files;", CB_PREFIX_STRING); } else { - output_line ("module->module_sources = NULL;"); + output_line ("module__->module_sources = NULL;"); } output_block_close (); diff --git a/cobc/parser.y b/cobc/parser.y index db525ec27..9f9524bee 100644 --- a/cobc/parser.y +++ b/cobc/parser.y @@ -157,7 +157,7 @@ enum inspect_rep_keyword { INSPECT_REP_ALL, INSPECT_REP_LEADING, INSPECT_REP_FIRST, - INSPECT_REP_TRAILING, + INSPECT_REP_TRAILING }; union examine_keyword { @@ -165,13 +165,13 @@ union examine_keyword { enum { EXAMINE_TAL_ALL, EXAMINE_TAL_LEADING, - EXAMINE_TAL_UNTIL_FIRST, + EXAMINE_TAL_UNTIL_FIRST } tallying; enum { EXAMINE_REP_ALL, EXAMINE_REP_LEADING, EXAMINE_REP_FIRST, - EXAMINE_REP_UNTIL_FIRST, + EXAMINE_REP_UNTIL_FIRST } replacing; }; diff --git a/cobc/typeck.c b/cobc/typeck.c index 49aaae433..a3994bad3 100644 --- a/cobc/typeck.c +++ b/cobc/typeck.c @@ -16060,7 +16060,7 @@ all_children_ok_qualified_by_only (struct cb_field * const f, return 0; } if (child->children - && !all_children_ok_qualified_by_only (child, qualifier)) { + && !all_children_ok_qualified_by_only (child, qualifier)) { return 0; } } diff --git a/configure.ac b/configure.ac index a83b77481..b57105e87 100644 --- a/configure.ac +++ b/configure.ac @@ -747,6 +747,8 @@ AC_CHECK_FUNCS([memmove memset setlocale fcntl strerror strcasecmp # more things to save... AC_CACHE_SAVE +CFLAGS="$curr_cflags $ERRWARN" + # Check for timezone AC_CACHE_CHECK([for timezone variable access], gc_cv_time_timezone, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], @@ -765,6 +767,7 @@ AC_CACHE_CHECK([for designated initializers], gc_cv_designated_inits, [ [[static const unsigned char valid_char[256] = { @<:@'0'@:>@ = 1, @<:@'1'@:>@ = 1 }; + if (valid_char['0'] != 1) return 1; ]])], [gc_cv_designated_inits=yes], [gc_cv_designated_inits=no] @@ -2596,14 +2599,12 @@ COB_EXPORT_DYN="$(eval echo $export_dynamic_flag_spec)" # FIXME: lt_prog_compiler_pic is not always correct, for example with occ COB_PIC_FLAGS=$(echo "$lt_prog_compiler_pic" | $SED -e 's/^ //') -if test "$enable_cflags_setting" = yes; then - if test "$enable_hardening" != yes; then - # Remove -O2 option added by AC_PROG_CC and add -O0 - if test "$enable_debug" = yes -o "$enable_code_coverage" = yes; then - CFLAGS=$(echo "$CFLAGS" | $SED -e 's/ *-O@<:@0-9a-zA-Z@:>@* */ /g' -e 's/ $//' -e 's/^ //') - if test "$COB_USES_GCC" = yes; then - CFLAGS="$CFLAGS -O0" - fi +if test "$enable_cflags_setting" = yes -a "$enable_hardening" != yes; then + # Remove -O2 option added by AC_PROG_CC and add -O0 + if test "$enable_debug" = yes -o "$enable_code_coverage" = yes; then + CFLAGS=$(echo "$CFLAGS" | $SED -e 's/ *-O@<:@0-9a-zA-Z@:>@* */ /g' -e 's/ $//' -e 's/^ //') + if test "$COB_USES_GCC" = yes; then + CFLAGS="$CFLAGS -O0" fi fi fi diff --git a/libcob/ChangeLog b/libcob/ChangeLog index 881c683c9..aed29a146 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -1,4 +1,17 @@ +2025-07-28 Simon Sobisch + + * common.h, fileio.c: new externalized typedef EXTFH_FUNC used in + EXTFH function declarations + * fileio.c (cob_file_sort_giving_extfh): use of EXTFH_FUNC to remove + pedantic warning about invalid cast from void pointer to function pointer + * common.c [!SIGFPE]: define per notes in gettext's old intdiv0.m4 + +2025-07-17 Simon Sobisch + + * mlio.c: cater for libxml2 ABI break with LIBXML_VERSION >= 21200 by + providing a check and definition of sax error handler with the old ABI + 2025-07-15 Simon Sobisch initial (unfinished) support for XML PARSE @@ -65,6 +78,17 @@ * fileio.c (indexed_open) [WITH_ANY_ISAM]: some GC4 backport top improve io-status in case of errors +2025-05-13 Simon Sobisch + + * call.c (do_cancel_module, cob_cancel_field): fixed definition for + cancel_func to not include too much parameters and added cast for C23 + +2025-05-13 David Declerck + + * call.c (COB_SYSTEM_GEN): fixed pointer cast per GCC + * call.c (cob_call): explicit cast to function pointer with maximum + possible arguments for C23 compat + 2025-04-22 Chuck Haatvedt new functions to support virtual heap diff --git a/libcob/Makefile.am b/libcob/Makefile.am index d5bfa203c..b0fb053b9 100644 --- a/libcob/Makefile.am +++ b/libcob/Makefile.am @@ -139,7 +139,7 @@ pkginclude_HEADERS = common.h version.h cobgetopt.h cobcapi.h \ include $(top_srcdir)/aminclude_static.am clean-local: code-coverage-clean -dist-clean-local: code-coverage-dist-clean +distclean-local: code-coverage-dist-clean CODE_COVERAGE_BRANCH_COVERAGE=1 CODE_COVERAGE_LCOV_OPTIONS = --no-external diff --git a/libcob/call.c b/libcob/call.c index 3ee8a0242..218297dc1 100644 --- a/libcob/call.c +++ b/libcob/call.c @@ -188,7 +188,7 @@ static unsigned int cob_jmp_primed; #undef COB_SYSTEM_GEN #define COB_SYSTEM_GEN(cob_name, pmin, pmax, c_name) \ - { cob_name, 0, {(void *(*)(void *))c_name} }, + { cob_name, 0, {(void *(*)(void))c_name} }, static struct system_table system_tab[] = { #include "system.def" @@ -432,7 +432,7 @@ do_cancel_module (struct call_hash *p, struct call_hash **base_hash, struct call_hash *prev) { struct struct_handle *dynptr; - int (*cancel_func)(const int, void *, void *, void *, void *); + int (*cancel_func)(const int); int nocancel; nocancel = 0; @@ -459,13 +459,8 @@ do_cancel_module (struct call_hash *p, struct call_hash **base_hash, && *p->module->module_ref_count) { nocancel = 1; } -#ifdef _MSC_VER -#pragma warning(suppress: 4113) /* funcint is a generic function prototype */ - cancel_func = p->module->module_cancel.funcint; -#else - cancel_func = p->module->module_cancel.funcint; -#endif - (void)cancel_func (-1, NULL, NULL, NULL, NULL); + cancel_func = (int (*)(const int))p->module->module_cancel.funcint; + (void)cancel_func (-1); p->module = NULL; if (nocancel) { @@ -1344,7 +1339,7 @@ cob_cancel_field (const cob_field *f, const struct cob_call_struct *cs) const char *entry; const struct cob_call_struct *s; - int (*cancel_func)(const int, void *, void *, void *, void *); + int (*cancel_func)(const int); /* LCOV_EXCL_START */ if (!cobglobptr) { @@ -1362,14 +1357,8 @@ cob_cancel_field (const cob_field *f, const struct cob_call_struct *cs) for (s = cs; s && s->cob_cstr_name; s++) { if (!strcmp (entry, s->cob_cstr_name)) { if (s->cob_cstr_cancel.funcvoid) { -#ifdef _MSC_VER -#pragma warning(suppress: 4113) /* funcint is a generic function prototype */ - cancel_func = s->cob_cstr_cancel.funcint; -#else - cancel_func = s->cob_cstr_cancel.funcint; -#endif - (void)cancel_func (-1, NULL, NULL, NULL, - NULL); + cancel_func = (int (*)(const int))s->cob_cstr_cancel.funcint; + (void)cancel_func (-1); } return; } @@ -1383,6 +1372,93 @@ cob_call (const char *name, const int argc, void **argv) void *pargv[MAX_CALL_FIELD_PARAMS] = { 0 }; cob_call_union unifunc; int i; +#if MAX_CALL_FIELD_PARAMS == 16 || \ + MAX_CALL_FIELD_PARAMS == 36 || \ + MAX_CALL_FIELD_PARAMS == 56 || \ + MAX_CALL_FIELD_PARAMS == 76 || \ + MAX_CALL_FIELD_PARAMS == 96 || \ + MAX_CALL_FIELD_PARAMS == 192 || \ + MAX_CALL_FIELD_PARAMS == 252 +#else +#error "Invalid MAX_CALL_FIELD_PARAMS value" +#endif + int (*funcint) ( + void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * +#if MAX_CALL_FIELD_PARAMS > 16 + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * +#if MAX_CALL_FIELD_PARAMS > 36 + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * +#if MAX_CALL_FIELD_PARAMS > 56 + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * +#if MAX_CALL_FIELD_PARAMS > 76 + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * +#if MAX_CALL_FIELD_PARAMS > 96 + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * +#if MAX_CALL_FIELD_PARAMS > 192 + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * +#endif +#endif +#endif +#endif +#endif +#endif + ); /* LCOV_EXCL_START */ if (!cobglobptr) { @@ -1404,18 +1480,84 @@ cob_call (const char *name, const int argc, void **argv) cobglobptr->cob_call_name_hash = 0; for (i = 0; i < argc; ++i) { pargv[i] = argv[i]; - } -#if MAX_CALL_FIELD_PARAMS == 16 || \ - MAX_CALL_FIELD_PARAMS == 36 || \ - MAX_CALL_FIELD_PARAMS == 56 || \ - MAX_CALL_FIELD_PARAMS == 76 || \ - MAX_CALL_FIELD_PARAMS == 96 || \ - MAX_CALL_FIELD_PARAMS == 192 || \ - MAX_CALL_FIELD_PARAMS == 252 -#else -#error "Invalid MAX_CALL_FIELD_PARAMS value" + } funcint = (int (*)( + void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * +#if MAX_CALL_FIELD_PARAMS > 16 + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * +#if MAX_CALL_FIELD_PARAMS > 36 + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * +#if MAX_CALL_FIELD_PARAMS > 56 + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * +#if MAX_CALL_FIELD_PARAMS > 76 + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * +#if MAX_CALL_FIELD_PARAMS > 96 + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * +#if MAX_CALL_FIELD_PARAMS > 192 + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * + ,void *, void *, void *, void * #endif - i = unifunc.funcint (pargv[0], pargv[1], pargv[2], pargv[3] +#endif +#endif +#endif +#endif +#endif + ))unifunc.funcint; + i = funcint (pargv[0], pargv[1], pargv[2], pargv[3] ,pargv[4], pargv[5], pargv[6], pargv[7] ,pargv[8], pargv[9], pargv[10], pargv[11] ,pargv[12], pargv[13], pargv[14], pargv[15] @@ -1459,6 +1601,7 @@ cob_call (const char *name, const int argc, void **argv) ,pargv[144], pargv[145], pargv[146], pargv[147] ,pargv[148], pargv[149], pargv[130], pargv[131] ,pargv[152], pargv[153], pargv[154], pargv[155] + ,pargv[156], pargv[157], pargv[158], pargv[159] ,pargv[160], pargv[161], pargv[162], pargv[163] ,pargv[164], pargv[165], pargv[166], pargv[167] ,pargv[168], pargv[169], pargv[170], pargv[171] diff --git a/libcob/common.c b/libcob/common.c index 8dddcf0dd..eb33e4b51 100644 --- a/libcob/common.c +++ b/libcob/common.c @@ -87,11 +87,19 @@ #define SIGABRT 6 #endif #ifndef SIGFPE +/* IRIX and AIX (when "xlc -qcheck" is used) yield signal SIGTRAP. */ +#if (defined (__sgi) || defined (_AIX)) && defined (SIGTRAP) +#define SIGFPE SIGTRAP +/* Linux/SPARC yields signal SIGILL. */ +#elif defined (__sparc__) && defined (__linux__) +#define SIGFPE SIGILL +#else #ifndef NSIG #define NSIG 240 #endif #define SIGFPE NSIG + 1 #endif +#endif #ifdef HAVE_LOCALE_H #include @@ -234,6 +242,18 @@ #endif /* Global variables */ + +#define ZERO_16 "0000000000000000" +#define ZERO_64 ZERO_16 ZERO_16 ZERO_16 ZERO_16 +#define ZERO_256 ZERO_64 ZERO_64 ZERO_64 ZERO_64 +const char *COB_ZEROES_ALPHABETIC = ZERO_256; +#undef ZERO_16 +#undef ZERO_64 +#undef ZERO_256 + +/* note: ancient compilers may only support a length of 509-1023 chars, + as soon as we actually see one, we can memset this var (for those) + in the init function */ #define SPACE_16 " " #define SPACE_64 SPACE_16 SPACE_16 SPACE_16 SPACE_16 #define SPACE_256 SPACE_64 SPACE_64 SPACE_64 SPACE_64 @@ -243,13 +263,6 @@ const char *COB_SPACES_ALPHABETIC = SPACE_1024; #undef SPACE_64 #undef SPACE_256 #undef SPACE_1024 -#define ZERO_16 "0000000000000000" -#define ZERO_64 ZERO_16 ZERO_16 ZERO_16 ZERO_16 -#define ZERO_256 ZERO_64 ZERO_64 ZERO_64 ZERO_64 -const char *COB_ZEROES_ALPHABETIC = ZERO_256; -#undef ZERO_16 -#undef ZERO_64 -#undef ZERO_256 struct cob_alloc_cache { struct cob_alloc_cache *next; /* Pointer to next */ @@ -844,7 +857,7 @@ cob_exit_common_modules (void) nxt = ptr->next; if (mod && mod->module_cancel.funcint) { mod->module_active = 0; - cancel_func = mod->module_cancel.funcint; + cancel_func = (int (*)(const int))mod->module_cancel.funcint; (void)cancel_func (-20); /* Clear just decimals */ } cob_free (ptr); diff --git a/libcob/common.h b/libcob/common.h index 5ed1a8fd9..fc520415e 100644 --- a/libcob/common.h +++ b/libcob/common.h @@ -2867,23 +2867,26 @@ COB_EXPIMP void cob_unlock_file (cob_file *, cob_field *); /* functions in fextfh.c which is the MF style EXTFH interface */ /***************************************************************/ COB_EXPIMP int EXTFH (unsigned char *, FCD3 *); -COB_EXPIMP void cob_extfh_open (int (*callfh)(unsigned char *, FCD3 *), - cob_file *, const enum cob_open_mode, const int, cob_field *); -COB_EXPIMP void cob_extfh_close (int (*callfh)(unsigned char *, FCD3 *), - cob_file *, cob_field *, const int, const int); -COB_EXPIMP void cob_extfh_read (int (*callfh)(unsigned char *, FCD3 *), - cob_file *, cob_field *, cob_field *, const int); -COB_EXPIMP void cob_extfh_read_next (int (*callfh)(unsigned char *, FCD3 *), - cob_file *, cob_field *, const int); -COB_EXPIMP void cob_extfh_rewrite (int (*callfh)(unsigned char *, FCD3 *), - cob_file *, cob_field *, const int, cob_field *); -COB_EXPIMP void cob_extfh_delete (int (*callfh)(unsigned char *, FCD3 *), - cob_file *, cob_field *); -COB_EXPIMP void cob_extfh_start (int (*callfh)(unsigned char *, FCD3 *), - cob_file *, const int, cob_field *, + +typedef int (*EXTFH_FUNC)(unsigned char *opcode, FCD3 *fcd); + +COB_EXPIMP void cob_extfh_open (EXTFH_FUNC callfh, cob_file *, + const enum cob_open_mode, const int, cob_field *); +COB_EXPIMP void cob_extfh_close (EXTFH_FUNC callfh, cob_file *, + cob_field *, const int, const int); +COB_EXPIMP void cob_extfh_read (EXTFH_FUNC callfh, cob_file *, + cob_field *, cob_field *, const int); +COB_EXPIMP void cob_extfh_read_next (EXTFH_FUNC callfh, cob_file *, + cob_field *, const int); +COB_EXPIMP void cob_extfh_rewrite (EXTFH_FUNC callfh, cob_file *, + cob_field *, const int, cob_field *); +COB_EXPIMP void cob_extfh_delete (EXTFH_FUNC callfh, cob_file *, + cob_field *); +COB_EXPIMP void cob_extfh_start (EXTFH_FUNC callfh, cob_file *, + const int, cob_field *, cob_field *, cob_field *); -COB_EXPIMP void cob_extfh_write (int (*callfh)(unsigned char *, FCD3 *), - cob_file *, cob_field *, const int, +COB_EXPIMP void cob_extfh_write (EXTFH_FUNC callfh, cob_file *, + cob_field *, const int, cob_field *, const unsigned int); COB_EXPIMP void cob_file_fcd_adrs (cob_file *, void *); diff --git a/libcob/fextfh.c b/libcob/fextfh.c index 3ed1074f9..66ad2dadf 100644 --- a/libcob/fextfh.c +++ b/libcob/fextfh.c @@ -940,9 +940,8 @@ save_fcd_status (FCD3 *fcd, int sts) * OPEN file */ void -cob_extfh_open ( - int (*callfh)(unsigned char *opcode, FCD3 *fcd), - cob_file *f, const enum cob_open_mode mode, const int sharing, cob_field *fnstatus) +cob_extfh_open (EXTFH_FUNC callfh, cob_file *f, + const enum cob_open_mode mode, const int sharing, cob_field *fnstatus) { unsigned char opcode[2]; FCD3 *fcd; @@ -979,9 +978,8 @@ cob_extfh_open ( * CLOSE file */ void -cob_extfh_close ( - int (*callfh)(unsigned char *opcode, FCD3 *fcd), - cob_file *f, cob_field *fnstatus, const int opt, const int remfil) +cob_extfh_close (EXTFH_FUNC callfh, cob_file *f, + cob_field *fnstatus, const int opt, const int remfil) { unsigned char opcode[2]; FCD3 *fcd; @@ -1051,9 +1049,8 @@ cob_extfh_close ( * START */ void -cob_extfh_start ( - int (*callfh)(unsigned char *opcode, FCD3 *fcd), - cob_file *f, const int cond, cob_field *key, cob_field *keysize, cob_field *fnstatus) +cob_extfh_start (EXTFH_FUNC callfh, cob_file *f, + const int cond, cob_field *key, cob_field *keysize, cob_field *fnstatus) { unsigned char opcode[2]; FCD3 *fcd; @@ -1096,9 +1093,8 @@ cob_extfh_start ( * READ */ void -cob_extfh_read ( - int (*callfh)(unsigned char *opcode, FCD3 *fcd), - cob_file *f, cob_field *key, cob_field *fnstatus, const int read_opts) +cob_extfh_read (EXTFH_FUNC callfh, cob_file *f, + cob_field *key, cob_field *fnstatus, const int read_opts) { unsigned char opcode[2]; FCD3 *fcd; @@ -1144,9 +1140,8 @@ cob_extfh_read ( * READ next */ void -cob_extfh_read_next ( - int (*callfh)(unsigned char *opcode, FCD3 *fcd), - cob_file *f, cob_field *fnstatus, const int read_opts) +cob_extfh_read_next (EXTFH_FUNC callfh, cob_file *f, + cob_field *fnstatus, const int read_opts) { unsigned char opcode[2]; FCD3 *fcd; @@ -1174,9 +1169,8 @@ cob_extfh_read_next ( * WRITE */ void -cob_extfh_write ( - int (*callfh)(unsigned char *opcode, FCD3 *fcd), - cob_file *f, cob_field *rec, const int opt, cob_field *fnstatus, const unsigned int check_eop) +cob_extfh_write (EXTFH_FUNC callfh, cob_file *f, + cob_field *rec, const int opt, cob_field *fnstatus, const unsigned int check_eop) { unsigned char opcode[2]; FCD3 *fcd; @@ -1211,9 +1205,8 @@ cob_extfh_write ( * REWRITE */ void -cob_extfh_rewrite ( - int (*callfh)(unsigned char *opcode, FCD3 *fcd), - cob_file *f, cob_field *rec, const int opt, cob_field *fnstatus) +cob_extfh_rewrite (EXTFH_FUNC callfh, cob_file *f, + cob_field *rec, const int opt, cob_field *fnstatus) { unsigned char opcode[2]; FCD3 *fcd; @@ -1245,9 +1238,8 @@ cob_extfh_rewrite ( * DELETE */ void -cob_extfh_delete ( - int (*callfh)(unsigned char *opcode, FCD3 *fcd), - cob_file *f, cob_field *fnstatus) +cob_extfh_delete (EXTFH_FUNC callfh, cob_file *f, + cob_field *fnstatus) { unsigned char opcode[2]; FCD3 *fcd; diff --git a/libcob/fileio.c b/libcob/fileio.c index 4ae694d1c..ad5426c71 100644 --- a/libcob/fileio.c +++ b/libcob/fileio.c @@ -9731,7 +9731,7 @@ void cob_file_sort_giving_extfh (cob_file *sort_file, const size_t varcnt, ...) { cob_file **fbase; - int (**callfh)(unsigned char *opcode, FCD3 *fcd); + EXTFH_FUNC *callfh; va_list args; size_t i, i_fh; @@ -9741,7 +9741,7 @@ cob_file_sort_giving_extfh (cob_file *sort_file, const size_t varcnt, ...) va_start (args, varcnt); for (i = 0; i < varcnt; i += 2) { fbase[i_fh] = va_arg (args, cob_file *); - callfh[i_fh++] = va_arg (args, void *); + callfh[i_fh++] = va_arg (args, EXTFH_FUNC); } va_end (args); cob_file_sort_giving_internal (sort_file, i_fh, fbase, callfh); diff --git a/m4/ax_check_define.m4 b/m4/ax_check_define.m4 index c10d1137a..e82499b8b 100644 --- a/m4/ax_check_define.m4 +++ b/m4/ax_check_define.m4 @@ -17,13 +17,14 @@ # LICENSE # # Copyright (c) 2008 Guido U. Draheim +# Copyright (c) 2023 David Seifert # # Copying and distribution of this file, with or without modification, are # permitted in any medium without royalty provided the copyright notice # and this notice are preserved. This file is offered as-is, without any # warranty. -#serial 11 +#serial 12 AU_ALIAS([AC_CHECK_DEFINED], [AC_CHECK_DEFINE]) AC_DEFUN([AC_CHECK_DEFINE],[ @@ -63,8 +64,8 @@ AC_CACHE_CHECK([for $2], ac_var, dnl AC_LANG_FUNC_LINK_TRY [AC_LINK_IFELSE([AC_LANG_PROGRAM([$1 #undef $2 - char $2 ();],[ - char (*f) () = $2; + char $2 (void);],[ + char (*f) (void) = $2; return f != $2; ])], [AS_VAR_SET(ac_var, yes)], [AS_VAR_SET(ac_var, no)])]) diff --git a/m4/ax_code_coverage.m4 b/m4/ax_code_coverage.m4 index 2fd0f7f57..96e1e164b 100644 --- a/m4/ax_code_coverage.m4 +++ b/m4/ax_code_coverage.m4 @@ -60,6 +60,9 @@ # Copyright (c) 2012 Paolo Borelli # Copyright (c) 2012 Dan Winship # Copyright (c) 2015,2018 Bastien ROUCARIES +# Copyright (c) 2019 Jonas Witschel +# Copyright (c) 2024 Jan Zizka +# Copyright (c) 2024 Rob Menke # # This library is free software; you can redistribute it and/or modify it # under the terms of the GNU Lesser General Public License as published by @@ -74,7 +77,7 @@ # You should have received a copy of the GNU Lesser General Public License # along with this program. If not, see . -#serial 34 +#serial 37 m4_define(_AX_CODE_COVERAGE_RULES,[ AX_ADD_AM_MACRO_STATIC([ @@ -144,7 +147,7 @@ code_coverage_v_lcov_cap_ = \$(code_coverage_v_lcov_cap_\$(AM_DEFAULT_VERBOSITY) code_coverage_v_lcov_cap_0 = @echo \" LCOV --capture\" \$(CODE_COVERAGE_OUTPUT_FILE); code_coverage_v_lcov_ign = \$(code_coverage_v_lcov_ign_\$(V)) code_coverage_v_lcov_ign_ = \$(code_coverage_v_lcov_ign_\$(AM_DEFAULT_VERBOSITY)) -code_coverage_v_lcov_ign_0 = @echo \" LCOV --remove /tmp/*\" \$(CODE_COVERAGE_IGNORE_PATTERN); +code_coverage_v_lcov_ign_0 = @echo \" LCOV --remove\" \"\$(CODE_COVERAGE_OUTPUT_FILE).tmp\" \$(CODE_COVERAGE_IGNORE_PATTERN); code_coverage_v_genhtml = \$(code_coverage_v_genhtml_\$(V)) code_coverage_v_genhtml_ = \$(code_coverage_v_genhtml_\$(AM_DEFAULT_VERBOSITY)) code_coverage_v_genhtml_0 = @echo \" GEN \" \"\$(CODE_COVERAGE_OUTPUT_DIRECTORY)\"; @@ -163,7 +166,7 @@ check-code-coverage: # Capture code coverage data code-coverage-capture: code-coverage-capture-hook \$(code_coverage_v_lcov_cap)\$(LCOV) \$(code_coverage_quiet) \$(addprefix --directory ,\$(CODE_COVERAGE_DIRECTORY)) --capture --output-file \"\$(CODE_COVERAGE_OUTPUT_FILE).tmp\" --test-name \"\$(call code_coverage_sanitize,\$(PACKAGE_NAME)-\$(PACKAGE_VERSION))\" --no-checksum --compat-libtool \$(CODE_COVERAGE_LCOV_SHOPTS) \$(CODE_COVERAGE_LCOV_OPTIONS) - \$(code_coverage_v_lcov_ign)\$(LCOV) \$(code_coverage_quiet) \$(addprefix --directory ,\$(CODE_COVERAGE_DIRECTORY)) --remove \"\$(CODE_COVERAGE_OUTPUT_FILE).tmp\" \"/tmp/*\" \$(CODE_COVERAGE_IGNORE_PATTERN) --output-file \"\$(CODE_COVERAGE_OUTPUT_FILE)\" \$(CODE_COVERAGE_LCOV_SHOPTS) \$(CODE_COVERAGE_LCOV_RMOPTS) + \$(code_coverage_v_lcov_ign)\$(LCOV) \$(code_coverage_quiet) \$(addprefix --directory ,\$(CODE_COVERAGE_DIRECTORY)) --remove \"\$(CODE_COVERAGE_OUTPUT_FILE).tmp\" \$(CODE_COVERAGE_IGNORE_PATTERN) --output-file \"\$(CODE_COVERAGE_OUTPUT_FILE)\" \$(CODE_COVERAGE_LCOV_SHOPTS) \$(CODE_COVERAGE_LCOV_RMOPTS) -@rm -f \"\$(CODE_COVERAGE_OUTPUT_FILE).tmp\" \$(code_coverage_v_genhtml)LANG=C \$(GENHTML) \$(code_coverage_quiet) \$(addprefix --prefix ,\$(CODE_COVERAGE_DIRECTORY)) --output-directory \"\$(CODE_COVERAGE_OUTPUT_DIRECTORY)\" --title \"\$(PACKAGE_NAME)-\$(PACKAGE_VERSION) Code Coverage\" --legend --show-details \"\$(CODE_COVERAGE_OUTPUT_FILE)\" \$(CODE_COVERAGE_GENHTML_OPTIONS) @echo \"file://\$(abs_builddir)/\$(CODE_COVERAGE_OUTPUT_DIRECTORY)/index.html\" @@ -232,12 +235,13 @@ AC_DEFUN([_AX_CODE_COVERAGE_ENABLED],[ AC_MSG_ERROR([Could not find genhtml from the lcov package]) ]) + AC_CHECK_LIB([gcov], [_gcov_init], [CODE_COVERAGE_LIBS="-lgcov"], [CODE_COVERAGE_LIBS=""]) + dnl Build the code coverage flags dnl Define CODE_COVERAGE_LDFLAGS for backwards compatibility CODE_COVERAGE_CPPFLAGS="-DNDEBUG" CODE_COVERAGE_CFLAGS="-O0 -g -fprofile-arcs -ftest-coverage" CODE_COVERAGE_CXXFLAGS="-O0 -g -fprofile-arcs -ftest-coverage" - CODE_COVERAGE_LIBS="-lgcov" AC_SUBST([CODE_COVERAGE_CPPFLAGS]) AC_SUBST([CODE_COVERAGE_CFLAGS]) diff --git a/m4/build-to-host.m4 b/m4/build-to-host.m4 new file mode 100644 index 000000000..01bff8f34 --- /dev/null +++ b/m4/build-to-host.m4 @@ -0,0 +1,274 @@ +# build-to-host.m4 +# serial 5 +dnl Copyright (C) 2023-2025 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. +dnl This file is offered as-is, without any warranty. + +dnl Written by Bruno Haible. + +dnl When the build environment ($build_os) is different from the target runtime +dnl environment ($host_os), file names may need to be converted from the build +dnl environment syntax to the target runtime environment syntax. This is +dnl because the Makefiles are executed (mostly) by build environment tools and +dnl therefore expect file names in build environment syntax, whereas the runtime +dnl expects file names in target runtime environment syntax. +dnl +dnl For example, if $build_os = cygwin and $host_os = mingw32, filenames need +dnl be converted from Cygwin syntax to native Windows syntax: +dnl /cygdrive/c/foo/bar -> C:\foo\bar +dnl /usr/local/share -> C:\cygwin64\usr\local\share +dnl +dnl gl_BUILD_TO_HOST([somedir]) +dnl This macro takes as input an AC_SUBSTed variable 'somedir', which must +dnl already have its final value assigned, and produces two additional +dnl AC_SUBSTed variables 'somedir_c' and 'somedir_c_make', that designate the +dnl same file name value, just in different syntax: +dnl - somedir_c is the file name in target runtime environment syntax, +dnl as a C string (starting and ending with a double-quote, +dnl and with escaped backslashes and double-quotes in +dnl between). +dnl - somedir_c_make is the same thing, escaped for use in a Makefile. + +AC_DEFUN([gl_BUILD_TO_HOST], +[ + AC_REQUIRE([AC_CANONICAL_BUILD]) + AC_REQUIRE([AC_CANONICAL_HOST]) + AC_REQUIRE([gl_BUILD_TO_HOST_INIT]) + + dnl Define somedir_c. + gl_final_[$1]="$[$1]" + dnl Translate it from build syntax to host syntax. + case "$build_os" in + cygwin*) + case "$host_os" in + mingw* | windows*) + gl_final_[$1]=`cygpath -w "$gl_final_[$1]"` ;; + esac + ;; + esac + dnl Convert it to C string syntax. + [$1]_c=`printf '%s\n' "$gl_final_[$1]" | sed -e "$gl_sed_double_backslashes" -e "$gl_sed_escape_doublequotes" | tr -d "$gl_tr_cr"` + [$1]_c='"'"$[$1]_c"'"' + AC_SUBST([$1_c]) + + dnl Define somedir_c_make. + [$1]_c_make=`printf '%s\n' "$[$1]_c" | sed -e "$gl_sed_escape_for_make_1" -e "$gl_sed_escape_for_make_2" | tr -d "$gl_tr_cr"` + dnl Use the substituted somedir variable, when possible, so that the user + dnl may adjust somedir a posteriori when there are no special characters. + if test "$[$1]_c_make" = '\"'"${gl_final_[$1]}"'\"'; then + [$1]_c_make='\"$([$1])\"' + fi + AC_SUBST([$1_c_make]) +]) + +dnl Some initializations for gl_BUILD_TO_HOST. +AC_DEFUN([gl_BUILD_TO_HOST_INIT], +[ + gl_sed_double_backslashes='s/\\/\\\\/g' + gl_sed_escape_doublequotes='s/"/\\"/g' +changequote(,)dnl + gl_sed_escape_for_make_1="s,\\([ \"&'();<>\\\\\`|]\\),\\\\\\1,g" +changequote([,])dnl + gl_sed_escape_for_make_2='s,\$,\\$$,g' + dnl Find out how to remove carriage returns from output. Solaris /usr/ucb/tr + dnl does not understand '\r'. + case `echo r | tr -d '\r'` in + '') gl_tr_cr='\015' ;; + *) gl_tr_cr='\r' ;; + esac +]) + + +dnl The following macros are convenience invocations of gl_BUILD_TO_HOST +dnl for some of the variables that are defined by Autoconf. +dnl To do so for _all_ the possible variables, use the module 'configmake'. + +dnl Defines bindir_c and bindir_c_make. +AC_DEFUN_ONCE([gl_BUILD_TO_HOST_BINDIR], +[ + dnl Find the final value of bindir. + gl_saved_prefix="${prefix}" + gl_saved_exec_prefix="${exec_prefix}" + gl_saved_bindir="${bindir}" + dnl Unfortunately, prefix and exec_prefix get only finally determined + dnl at the end of configure. + if test "X$prefix" = "XNONE"; then + prefix="$ac_default_prefix" + fi + if test "X$exec_prefix" = "XNONE"; then + exec_prefix='${prefix}' + fi + eval exec_prefix="$exec_prefix" + eval bindir="$bindir" + gl_BUILD_TO_HOST([bindir]) + bindir="${gl_saved_bindir}" + exec_prefix="${gl_saved_exec_prefix}" + prefix="${gl_saved_prefix}" +]) + +dnl Defines datadir_c and datadir_c_make, +dnl where datadir = $(datarootdir) +AC_DEFUN_ONCE([gl_BUILD_TO_HOST_DATADIR], +[ + dnl Find the final value of datadir. + gl_saved_prefix="${prefix}" + gl_saved_datarootdir="${datarootdir}" + gl_saved_datadir="${datadir}" + dnl Unfortunately, prefix gets only finally determined at the end of + dnl configure. + if test "X$prefix" = "XNONE"; then + prefix="$ac_default_prefix" + fi + eval datarootdir="$datarootdir" + eval datadir="$datadir" + gl_BUILD_TO_HOST([datadir]) + datadir="${gl_saved_datadir}" + datarootdir="${gl_saved_datarootdir}" + prefix="${gl_saved_prefix}" +]) + +dnl Defines libdir_c and libdir_c_make. +AC_DEFUN_ONCE([gl_BUILD_TO_HOST_LIBDIR], +[ + dnl Find the final value of libdir. + gl_saved_prefix="${prefix}" + gl_saved_exec_prefix="${exec_prefix}" + gl_saved_libdir="${libdir}" + dnl Unfortunately, prefix and exec_prefix get only finally determined + dnl at the end of configure. + if test "X$prefix" = "XNONE"; then + prefix="$ac_default_prefix" + fi + if test "X$exec_prefix" = "XNONE"; then + exec_prefix='${prefix}' + fi + eval exec_prefix="$exec_prefix" + eval libdir="$libdir" + gl_BUILD_TO_HOST([libdir]) + libdir="${gl_saved_libdir}" + exec_prefix="${gl_saved_exec_prefix}" + prefix="${gl_saved_prefix}" +]) + +dnl Defines libexecdir_c and libexecdir_c_make. +AC_DEFUN_ONCE([gl_BUILD_TO_HOST_LIBEXECDIR], +[ + dnl Find the final value of libexecdir. + gl_saved_prefix="${prefix}" + gl_saved_exec_prefix="${exec_prefix}" + gl_saved_libexecdir="${libexecdir}" + dnl Unfortunately, prefix and exec_prefix get only finally determined + dnl at the end of configure. + if test "X$prefix" = "XNONE"; then + prefix="$ac_default_prefix" + fi + if test "X$exec_prefix" = "XNONE"; then + exec_prefix='${prefix}' + fi + eval exec_prefix="$exec_prefix" + eval libexecdir="$libexecdir" + gl_BUILD_TO_HOST([libexecdir]) + libexecdir="${gl_saved_libexecdir}" + exec_prefix="${gl_saved_exec_prefix}" + prefix="${gl_saved_prefix}" +]) + +dnl Defines localedir_c and localedir_c_make. +AC_DEFUN_ONCE([gl_BUILD_TO_HOST_LOCALEDIR], +[ + dnl Find the final value of localedir. + gl_saved_prefix="${prefix}" + gl_saved_datarootdir="${datarootdir}" + gl_saved_localedir="${localedir}" + dnl Unfortunately, prefix gets only finally determined at the end of + dnl configure. + if test "X$prefix" = "XNONE"; then + prefix="$ac_default_prefix" + fi + eval datarootdir="$datarootdir" + eval localedir="$localedir" + gl_BUILD_TO_HOST([localedir]) + localedir="${gl_saved_localedir}" + datarootdir="${gl_saved_datarootdir}" + prefix="${gl_saved_prefix}" +]) + +dnl Defines pkgdatadir_c and pkgdatadir_c_make, +dnl where pkgdatadir = $(datadir)/$(PACKAGE) +AC_DEFUN_ONCE([gl_BUILD_TO_HOST_PKGDATADIR], +[ + dnl Find the final value of pkgdatadir. + gl_saved_prefix="${prefix}" + gl_saved_datarootdir="${datarootdir}" + gl_saved_datadir="${datadir}" + gl_saved_pkgdatadir="${pkgdatadir}" + dnl Unfortunately, prefix gets only finally determined at the end of + dnl configure. + if test "X$prefix" = "XNONE"; then + prefix="$ac_default_prefix" + fi + eval datarootdir="$datarootdir" + eval datadir="$datadir" + eval pkgdatadir="$pkgdatadir" + gl_BUILD_TO_HOST([pkgdatadir]) + pkgdatadir="${gl_saved_pkgdatadir}" + datadir="${gl_saved_datadir}" + datarootdir="${gl_saved_datarootdir}" + prefix="${gl_saved_prefix}" +]) + +dnl Defines pkglibdir_c and pkglibdir_c_make, +dnl where pkglibdir = $(libdir)/$(PACKAGE) +AC_DEFUN_ONCE([gl_BUILD_TO_HOST_PKGLIBDIR], +[ + dnl Find the final value of pkglibdir. + gl_saved_prefix="${prefix}" + gl_saved_exec_prefix="${exec_prefix}" + gl_saved_libdir="${libdir}" + gl_saved_pkglibdir="${pkglibdir}" + dnl Unfortunately, prefix and exec_prefix get only finally determined + dnl at the end of configure. + if test "X$prefix" = "XNONE"; then + prefix="$ac_default_prefix" + fi + if test "X$exec_prefix" = "XNONE"; then + exec_prefix='${prefix}' + fi + eval exec_prefix="$exec_prefix" + eval libdir="$libdir" + eval pkglibdir="$pkglibdir" + gl_BUILD_TO_HOST([pkglibdir]) + pkglibdir="${gl_saved_pkglibdir}" + libdir="${gl_saved_libdir}" + exec_prefix="${gl_saved_exec_prefix}" + prefix="${gl_saved_prefix}" +]) + +dnl Defines pkglibexecdir_c and pkglibexecdir_c_make, +dnl where pkglibexecdir = $(libexecdir)/$(PACKAGE) +AC_DEFUN_ONCE([gl_BUILD_TO_HOST_PKGLIBEXECDIR], +[ + dnl Find the final value of pkglibexecdir. + gl_saved_prefix="${prefix}" + gl_saved_exec_prefix="${exec_prefix}" + gl_saved_libexecdir="${libexecdir}" + gl_saved_pkglibexecdir="${pkglibexecdir}" + dnl Unfortunately, prefix and exec_prefix get only finally determined + dnl at the end of configure. + if test "X$prefix" = "XNONE"; then + prefix="$ac_default_prefix" + fi + if test "X$exec_prefix" = "XNONE"; then + exec_prefix='${prefix}' + fi + eval exec_prefix="$exec_prefix" + eval libexecdir="$libexecdir" + eval pkglibexecdir="$pkglibexecdir" + gl_BUILD_TO_HOST([pkglibexecdir]) + pkglibexecdir="${gl_saved_pkglibexecdir}" + libexecdir="${gl_saved_libexecdir}" + exec_prefix="${gl_saved_exec_prefix}" + prefix="${gl_saved_prefix}" +]) diff --git a/m4/gettext.m4 b/m4/gettext.m4 index 4f25a27d9..43bc65ac7 100644 --- a/m4/gettext.m4 +++ b/m4/gettext.m4 @@ -1,8 +1,10 @@ -# gettext.m4 serial 71 (gettext-0.20.2) -dnl Copyright (C) 1995-2014, 2016, 2018-2020 Free Software Foundation, Inc. +# gettext.m4 +# serial 81 (gettext-0.23) +dnl Copyright (C) 1995-2014, 2016, 2018-2025 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. +dnl This file is offered as-is, without any warranty. dnl dnl This file can be used in projects which are not available under dnl the GNU General Public License or the GNU Lesser General Public @@ -15,16 +17,18 @@ dnl They are *not* in the public domain. dnl Authors: dnl Ulrich Drepper , 1995-2000. -dnl Bruno Haible , 2000-2006, 2008-2010. +dnl Bruno Haible , 2000-2024. dnl Macro to add for using GNU gettext. dnl Usage: AM_GNU_GETTEXT([INTLSYMBOL], [NEEDSYMBOL], [INTLDIR]). -dnl INTLSYMBOL must be one of 'external', 'use-libtool'. -dnl INTLSYMBOL should be 'external' for packages other than GNU gettext, and -dnl 'use-libtool' for the packages 'gettext-runtime' and 'gettext-tools'. -dnl If INTLSYMBOL is 'use-libtool', then a libtool library -dnl $(top_builddir)/intl/libintl.la will be created (shared and/or static, +dnl INTLSYMBOL must be one of 'external', 'use-libtool', 'here'. +dnl INTLSYMBOL should be 'external' for packages other than GNU gettext. +dnl It should be 'use-libtool' for the packages 'gettext-runtime' and +dnl 'gettext-tools'. +dnl It should be 'here' for the package 'gettext-runtime/intl'. +dnl If INTLSYMBOL is 'here', then a libtool library +dnl $(top_builddir)/libintl.la will be created (shared and/or static, dnl depending on --{enable,disable}-{shared,static} and on the presence of dnl AM-DISABLE-SHARED). dnl If NEEDSYMBOL is specified and is 'need-ngettext', then GNU gettext @@ -55,24 +59,21 @@ dnl AC_DEFUN([AM_GNU_GETTEXT], [ dnl Argument checking. - ifelse([$1], [], , [ifelse([$1], [external], , [ifelse([$1], [use-libtool], , + m4_if([$1], [], , [m4_if([$1], [external], , [m4_if([$1], [use-libtool], , [m4_if([$1], [here], , [errprint([ERROR: invalid first argument to AM_GNU_GETTEXT -])])])]) - ifelse(ifelse([$1], [], [old])[]ifelse([$1], [no-libtool], [old]), [old], +])])])])]) + m4_if(m4_if([$1], [], [old])[]m4_if([$1], [no-libtool], [old]), [old], [errprint([ERROR: Use of AM_GNU_GETTEXT without [external] argument is no longer supported. ])]) - ifelse([$2], [], , [ifelse([$2], [need-ngettext], , [ifelse([$2], [need-formatstring-macros], , + m4_if([$2], [], , [m4_if([$2], [need-ngettext], , [m4_if([$2], [need-formatstring-macros], , [errprint([ERROR: invalid second argument to AM_GNU_GETTEXT ])])])]) - define([gt_included_intl], - ifelse([$1], [external], [no], [yes])) + define([gt_building_libintl_in_same_build_tree], + m4_if([$1], [use-libtool], [yes], [m4_if([$1], [here], [yes], [no])])) gt_NEEDS_INIT AM_GNU_GETTEXT_NEED([$2]) AC_REQUIRE([AM_PO_SUBDIRS])dnl - ifelse(gt_included_intl, yes, [ - AC_REQUIRE([AM_INTL_SUBDIR])dnl - ]) dnl Prerequisites of AC_LIB_LINKFLAGS_BODY. AC_REQUIRE([AC_LIB_PREPARE_PREFIX]) @@ -82,13 +83,13 @@ AC_DEFUN([AM_GNU_GETTEXT], dnl Ideally we would do this search only after the dnl if test "$USE_NLS" = "yes"; then dnl if { eval "gt_val=\$$gt_func_gnugettext_libc"; test "$gt_val" != "yes"; }; then - dnl tests. But if configure.in invokes AM_ICONV after AM_GNU_GETTEXT + dnl tests. But if configure.ac invokes AM_ICONV after AM_GNU_GETTEXT dnl the configure script would need to contain the same shell code dnl again, outside any 'if'. There are two solutions: dnl - Invoke AM_ICONV_LINKFLAGS_BODY here, outside any 'if'. dnl - Control the expansions in more detail using AC_PROVIDE_IFELSE. dnl Since AC_PROVIDE_IFELSE is not documented, we avoid it. - ifelse(gt_included_intl, yes, , [ + m4_if(gt_building_libintl_in_same_build_tree, yes, , [ AC_REQUIRE([AM_ICONV_LINKFLAGS_BODY]) ]) @@ -98,8 +99,7 @@ AC_DEFUN([AM_GNU_GETTEXT], dnl Set USE_NLS. AC_REQUIRE([AM_NLS]) - ifelse(gt_included_intl, yes, [ - BUILD_INCLUDED_LIBINTL=no + m4_if(gt_building_libintl_in_same_build_tree, yes, [ USE_INCLUDED_LIBINTL=no ]) LIBINTL= @@ -118,7 +118,7 @@ AC_DEFUN([AM_GNU_GETTEXT], dnl If we use NLS figure out what method if test "$USE_NLS" = "yes"; then gt_use_preinstalled_gnugettext=no - ifelse(gt_included_intl, yes, [ + m4_if(gt_building_libintl_in_same_build_tree, yes, [ AC_MSG_CHECKING([whether included gettext is requested]) AC_ARG_WITH([included-gettext], [ --with-included-gettext use the GNU gettext library included here], @@ -174,7 +174,7 @@ return * gettext ("")$gt_expression_test_code + __GNU_GETTEXT_SYMBOL_EXPRESSION if { eval "gt_val=\$$gt_func_gnugettext_libc"; test "$gt_val" != "yes"; }; then dnl Sometimes libintl requires libiconv, so first search for libiconv. - ifelse(gt_included_intl, yes, , [ + m4_if(gt_building_libintl_in_same_build_tree, yes, , [ AM_ICONV_LINK ]) dnl Search for libintl and define LIBINTL, LTLIBINTL and INCINTL @@ -184,9 +184,9 @@ return * gettext ("")$gt_expression_test_code + __GNU_GETTEXT_SYMBOL_EXPRESSION AC_LIB_LINKFLAGS_BODY([intl]) AC_CACHE_CHECK([for GNU gettext in libintl], [$gt_func_gnugettext_libintl], - [gt_save_CPPFLAGS="$CPPFLAGS" + [gt_saved_CPPFLAGS="$CPPFLAGS" CPPFLAGS="$CPPFLAGS $INCINTL" - gt_save_LIBS="$LIBS" + gt_saved_LIBS="$LIBS" LIBS="$LIBS $LIBINTL" dnl Now see whether libintl exists and does not depend on libiconv. AC_LINK_IFELSE( @@ -212,9 +212,16 @@ return * gettext ("")$gt_expression_test_code + __GNU_GETTEXT_SYMBOL_EXPRESSION ]])], [eval "$gt_func_gnugettext_libintl=yes"], [eval "$gt_func_gnugettext_libintl=no"]) - dnl Now see whether libintl exists and depends on libiconv. - if { eval "gt_val=\$$gt_func_gnugettext_libintl"; test "$gt_val" != yes; } && test -n "$LIBICONV"; then - LIBS="$LIBS $LIBICONV" + dnl Now see whether libintl exists and depends on libiconv or other + dnl OS dependent libraries, specifically on macOS and AIX. + gt_LIBINTL_EXTRA="$INTL_MACOSX_LIBS" + AC_REQUIRE([AC_CANONICAL_HOST]) + case "$host_os" in + aix*) gt_LIBINTL_EXTRA="-lpthread" ;; + esac + if { eval "gt_val=\$$gt_func_gnugettext_libintl"; test "$gt_val" != yes; } \ + && { test -n "$LIBICONV" || test -n "$gt_LIBINTL_EXTRA"; }; then + LIBS="$LIBS $LIBICONV $gt_LIBINTL_EXTRA" AC_LINK_IFELSE( [AC_LANG_PROGRAM( [[ @@ -236,13 +243,13 @@ $gt_revision_test_code bindtextdomain ("", ""); return * gettext ("")$gt_expression_test_code + __GNU_GETTEXT_SYMBOL_EXPRESSION ]])], - [LIBINTL="$LIBINTL $LIBICONV" - LTLIBINTL="$LTLIBINTL $LTLIBICONV" + [LIBINTL="$LIBINTL $LIBICONV $gt_LIBINTL_EXTRA" + LTLIBINTL="$LTLIBINTL $LTLIBICONV $gt_LIBINTL_EXTRA" eval "$gt_func_gnugettext_libintl=yes" ]) fi - CPPFLAGS="$gt_save_CPPFLAGS" - LIBS="$gt_save_LIBS"]) + CPPFLAGS="$gt_saved_CPPFLAGS" + LIBS="$gt_saved_LIBS"]) fi dnl If an already present or preinstalled GNU gettext() is found, @@ -252,7 +259,8 @@ return * gettext ("")$gt_expression_test_code + __GNU_GETTEXT_SYMBOL_EXPRESSION if { eval "gt_val=\$$gt_func_gnugettext_libc"; test "$gt_val" = "yes"; } \ || { { eval "gt_val=\$$gt_func_gnugettext_libintl"; test "$gt_val" = "yes"; } \ && test "$PACKAGE" != gettext-runtime \ - && test "$PACKAGE" != gettext-tools; }; then + && test "$PACKAGE" != gettext-tools \ + && test "$PACKAGE" != libintl; }; then gt_use_preinstalled_gnugettext=yes else dnl Reset the values set by searching for libintl. @@ -261,7 +269,7 @@ return * gettext ("")$gt_expression_test_code + __GNU_GETTEXT_SYMBOL_EXPRESSION INCINTL= fi - ifelse(gt_included_intl, yes, [ + m4_if(gt_building_libintl_in_same_build_tree, yes, [ if test "$gt_use_preinstalled_gnugettext" != "yes"; then dnl GNU gettext is not found in the C library. dnl Fall back on included GNU gettext library. @@ -271,10 +279,9 @@ return * gettext ("")$gt_expression_test_code + __GNU_GETTEXT_SYMBOL_EXPRESSION if test "$nls_cv_use_gnu_gettext" = "yes"; then dnl Mark actions used to generate GNU NLS library. - BUILD_INCLUDED_LIBINTL=yes USE_INCLUDED_LIBINTL=yes - LIBINTL="ifelse([$3],[],\${top_builddir}/intl,[$3])/libintl.la $LIBICONV $LIBTHREAD" - LTLIBINTL="ifelse([$3],[],\${top_builddir}/intl,[$3])/libintl.la $LTLIBICONV $LTLIBTHREAD" + LIBINTL="m4_if([$3],[],\${top_builddir}/intl,[$3])/libintl.la $LIBICONV $LIBTHREAD" + LTLIBINTL="m4_if([$3],[],\${top_builddir}/intl,[$3])/libintl.la $LTLIBICONV $LTLIBTHREAD" LIBS=`echo " $LIBS " | sed -e 's/ -lintl / /' -e 's/^ //' -e 's/ $//'` fi @@ -341,25 +348,25 @@ return * gettext ("")$gt_expression_test_code + __GNU_GETTEXT_SYMBOL_EXPRESSION POSUB=po fi - ifelse(gt_included_intl, yes, [ - dnl In GNU gettext we have to set BUILD_INCLUDED_LIBINTL to 'yes' - dnl because some of the testsuite requires it. - BUILD_INCLUDED_LIBINTL=yes - + m4_if(gt_building_libintl_in_same_build_tree, yes, [ dnl Make all variables we use known to autoconf. - AC_SUBST([BUILD_INCLUDED_LIBINTL]) AC_SUBST([USE_INCLUDED_LIBINTL]) AC_SUBST([CATOBJEXT]) ]) - dnl For backward compatibility. Some Makefiles may be using this. - INTLLIBS="$LIBINTL" - AC_SUBST([INTLLIBS]) + m4_if(gt_building_libintl_in_same_build_tree, yes, [], [ + dnl For backward compatibility. Some Makefiles may be using this. + INTLLIBS="$LIBINTL" + AC_SUBST([INTLLIBS]) + ]) dnl Make all documented variables known to autoconf. AC_SUBST([LIBINTL]) AC_SUBST([LTLIBINTL]) AC_SUBST([POSUB]) + + dnl Define localedir_c and localedir_c_make. + gl_BUILD_TO_HOST_LOCALEDIR ]) diff --git a/m4/glibc2.m4 b/m4/glibc2.m4 deleted file mode 100644 index 785bba095..000000000 --- a/m4/glibc2.m4 +++ /dev/null @@ -1,31 +0,0 @@ -# glibc2.m4 serial 3 -dnl Copyright (C) 2000-2002, 2004, 2008, 2010-2016 Free Software Foundation, -dnl Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. - -# Test for the GNU C Library, version 2.0 or newer. -# From Bruno Haible. - -AC_DEFUN([gt_GLIBC2], - [ - AC_CACHE_CHECK([whether we are using the GNU C Library 2 or newer], - [ac_cv_gnu_library_2], - [AC_EGREP_CPP([Lucky GNU user], - [ -#include -#ifdef __GNU_LIBRARY__ - #if (__GLIBC__ >= 2) && !defined __UCLIBC__ - Lucky GNU user - #endif -#endif - ], - [ac_cv_gnu_library_2=yes], - [ac_cv_gnu_library_2=no]) - ] - ) - AC_SUBST([GLIBC2]) - GLIBC2="$ac_cv_gnu_library_2" - ] -) diff --git a/m4/glibc21.m4 b/m4/glibc21.m4 deleted file mode 100644 index dafebf501..000000000 --- a/m4/glibc21.m4 +++ /dev/null @@ -1,34 +0,0 @@ -# glibc21.m4 serial 5 -dnl Copyright (C) 2000-2002, 2004, 2008, 2010-2016 Free Software Foundation, -dnl Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. - -# Test for the GNU C Library, version 2.1 or newer, or uClibc. -# From Bruno Haible. - -AC_DEFUN([gl_GLIBC21], - [ - AC_CACHE_CHECK([whether we are using the GNU C Library >= 2.1 or uClibc], - [ac_cv_gnu_library_2_1], - [AC_EGREP_CPP([Lucky], - [ -#include -#ifdef __GNU_LIBRARY__ - #if (__GLIBC__ == 2 && __GLIBC_MINOR__ >= 1) || (__GLIBC__ > 2) - Lucky GNU user - #endif -#endif -#ifdef __UCLIBC__ - Lucky user -#endif - ], - [ac_cv_gnu_library_2_1=yes], - [ac_cv_gnu_library_2_1=no]) - ] - ) - AC_SUBST([GLIBC21]) - GLIBC21="$ac_cv_gnu_library_2_1" - ] -) diff --git a/m4/host-cpu-c-abi.m4 b/m4/host-cpu-c-abi.m4 new file mode 100644 index 000000000..6ca7721a3 --- /dev/null +++ b/m4/host-cpu-c-abi.m4 @@ -0,0 +1,532 @@ +# host-cpu-c-abi.m4 +# serial 20 +dnl Copyright (C) 2002-2025 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. +dnl This file is offered as-is, without any warranty. + +dnl From Bruno Haible and Sam Steingold. + +dnl Sets the HOST_CPU variable to the canonical name of the CPU. +dnl Sets the HOST_CPU_C_ABI variable to the canonical name of the CPU with its +dnl C language ABI (application binary interface). +dnl Also defines __${HOST_CPU}__ and __${HOST_CPU_C_ABI}__ as C macros in +dnl config.h. +dnl +dnl This canonical name can be used to select a particular assembly language +dnl source file that will interoperate with C code on the given host. +dnl +dnl For example: +dnl * 'i386' and 'sparc' are different canonical names, because code for i386 +dnl will not run on SPARC CPUs and vice versa. They have different +dnl instruction sets. +dnl * 'sparc' and 'sparc64' are different canonical names, because code for +dnl 'sparc' and code for 'sparc64' cannot be linked together: 'sparc' code +dnl contains 32-bit instructions, whereas 'sparc64' code contains 64-bit +dnl instructions. A process on a SPARC CPU can be in 32-bit mode or in 64-bit +dnl mode, but not both. +dnl * 'mips' and 'mipsn32' are different canonical names, because they use +dnl different argument passing and return conventions for C functions, and +dnl although the instruction set of 'mips' is a large subset of the +dnl instruction set of 'mipsn32'. +dnl * 'mipsn32' and 'mips64' are different canonical names, because they use +dnl different sizes for the C types like 'int' and 'void *', and although +dnl the instruction sets of 'mipsn32' and 'mips64' are the same. +dnl * The same canonical name is used for different endiannesses. You can +dnl determine the endianness through preprocessor symbols: +dnl - 'arm': test __ARMEL__. +dnl - 'mips', 'mipsn32', 'mips64': test _MIPSEB vs. _MIPSEL. +dnl - 'powerpc64': test __BIG_ENDIAN__ vs. __LITTLE_ENDIAN__. +dnl * The same name 'i386' is used for CPUs of type i386, i486, i586 +dnl (Pentium), AMD K7, Pentium II, Pentium IV, etc., because +dnl - Instructions that do not exist on all of these CPUs (cmpxchg, +dnl MMX, SSE, SSE2, 3DNow! etc.) are not frequently used. If your +dnl assembly language source files use such instructions, you will +dnl need to make the distinction. +dnl - Speed of execution of the common instruction set is reasonable across +dnl the entire family of CPUs. If you have assembly language source files +dnl that are optimized for particular CPU types (like GNU gmp has), you +dnl will need to make the distinction. +dnl See . +AC_DEFUN([gl_HOST_CPU_C_ABI], +[ + AC_REQUIRE([AC_CANONICAL_HOST]) + AC_REQUIRE([gl_C_ASM]) + AC_CACHE_CHECK([host CPU and C ABI], [gl_cv_host_cpu_c_abi], + [case "$host_cpu" in + +changequote(,)dnl + i[34567]86 ) +changequote([,])dnl + gl_cv_host_cpu_c_abi=i386 + ;; + + x86_64 ) + # On x86_64 systems, the C compiler may be generating code in one of + # these ABIs: + # - 64-bit instruction set, 64-bit pointers, 64-bit 'long': x86_64. + # - 64-bit instruction set, 64-bit pointers, 32-bit 'long': x86_64 + # with native Windows (mingw, MSVC). + # - 64-bit instruction set, 32-bit pointers, 32-bit 'long': x86_64-x32. + # - 32-bit instruction set, 32-bit pointers, 32-bit 'long': i386. + AC_COMPILE_IFELSE( + [AC_LANG_SOURCE( + [[#if (defined __x86_64__ || defined __amd64__ \ + || defined _M_X64 || defined _M_AMD64) + int ok; + #else + error fail + #endif + ]])], + [AC_COMPILE_IFELSE( + [AC_LANG_SOURCE( + [[#if defined __ILP32__ || defined _ILP32 + int ok; + #else + error fail + #endif + ]])], + [gl_cv_host_cpu_c_abi=x86_64-x32], + [gl_cv_host_cpu_c_abi=x86_64])], + [gl_cv_host_cpu_c_abi=i386]) + ;; + +changequote(,)dnl + alphaev[4-8] | alphaev56 | alphapca5[67] | alphaev6[78] ) +changequote([,])dnl + gl_cv_host_cpu_c_abi=alpha + ;; + + arm* | aarch64 ) + # Assume arm with EABI. + # On arm64 systems, the C compiler may be generating code in one of + # these ABIs: + # - aarch64 instruction set, 64-bit pointers, 64-bit 'long': arm64. + # - aarch64 instruction set, 32-bit pointers, 32-bit 'long': arm64-ilp32. + # - 32-bit instruction set, 32-bit pointers, 32-bit 'long': arm or armhf. + AC_COMPILE_IFELSE( + [AC_LANG_SOURCE( + [[#ifdef __aarch64__ + int ok; + #else + error fail + #endif + ]])], + [AC_COMPILE_IFELSE( + [AC_LANG_SOURCE( + [[#if defined __ILP32__ || defined _ILP32 + int ok; + #else + error fail + #endif + ]])], + [gl_cv_host_cpu_c_abi=arm64-ilp32], + [gl_cv_host_cpu_c_abi=arm64])], + [# Don't distinguish little-endian and big-endian arm, since they + # don't require different machine code for simple operations and + # since the user can distinguish them through the preprocessor + # defines __ARMEL__ vs. __ARMEB__. + # But distinguish arm which passes floating-point arguments and + # return values in integer registers (r0, r1, ...) - this is + # gcc -mfloat-abi=soft or gcc -mfloat-abi=softfp - from arm which + # passes them in float registers (s0, s1, ...) and double registers + # (d0, d1, ...) - this is gcc -mfloat-abi=hard. GCC 4.6 or newer + # sets the preprocessor defines __ARM_PCS (for the first case) and + # __ARM_PCS_VFP (for the second case), but older GCC does not. + echo 'double ddd; void func (double dd) { ddd = dd; }' > conftest.c + # Look for a reference to the register d0 in the .s file. + AC_TRY_COMMAND(${CC-cc} $CFLAGS $CPPFLAGS $gl_c_asm_opt conftest.c) >/dev/null 2>&1 + if LC_ALL=C grep 'd0,' conftest.$gl_asmext >/dev/null; then + gl_cv_host_cpu_c_abi=armhf + else + gl_cv_host_cpu_c_abi=arm + fi + rm -fr conftest* + ]) + ;; + + hppa1.0 | hppa1.1 | hppa2.0* | hppa64 ) + # On hppa, the C compiler may be generating 32-bit code or 64-bit + # code. In the latter case, it defines _LP64 and __LP64__. + AC_COMPILE_IFELSE( + [AC_LANG_SOURCE( + [[#ifdef __LP64__ + int ok; + #else + error fail + #endif + ]])], + [gl_cv_host_cpu_c_abi=hppa64], + [gl_cv_host_cpu_c_abi=hppa]) + ;; + + ia64* ) + # On ia64 on HP-UX, the C compiler may be generating 64-bit code or + # 32-bit code. In the latter case, it defines _ILP32. + AC_COMPILE_IFELSE( + [AC_LANG_SOURCE( + [[#ifdef _ILP32 + int ok; + #else + error fail + #endif + ]])], + [gl_cv_host_cpu_c_abi=ia64-ilp32], + [gl_cv_host_cpu_c_abi=ia64]) + ;; + + mips* ) + # We should also check for (_MIPS_SZPTR == 64), but gcc keeps this + # at 32. + AC_COMPILE_IFELSE( + [AC_LANG_SOURCE( + [[#if defined _MIPS_SZLONG && (_MIPS_SZLONG == 64) + int ok; + #else + error fail + #endif + ]])], + [gl_cv_host_cpu_c_abi=mips64], + [# In the n32 ABI, _ABIN32 is defined, _ABIO32 is not defined (but + # may later get defined by ), and _MIPS_SIM == _ABIN32. + # In the 32 ABI, _ABIO32 is defined, _ABIN32 is not defined (but + # may later get defined by ), and _MIPS_SIM == _ABIO32. + AC_COMPILE_IFELSE( + [AC_LANG_SOURCE( + [[#if (_MIPS_SIM == _ABIN32) + int ok; + #else + error fail + #endif + ]])], + [gl_cv_host_cpu_c_abi=mipsn32], + [gl_cv_host_cpu_c_abi=mips])]) + ;; + + powerpc* ) + # Different ABIs are in use on AIX vs. Mac OS X vs. Linux,*BSD. + # No need to distinguish them here; the caller may distinguish + # them based on the OS. + # On powerpc64 systems, the C compiler may still be generating + # 32-bit code. And on powerpc-ibm-aix systems, the C compiler may + # be generating 64-bit code. + AC_COMPILE_IFELSE( + [AC_LANG_SOURCE( + [[#if defined __powerpc64__ || defined __LP64__ + int ok; + #else + error fail + #endif + ]])], + [# On powerpc64, there are two ABIs on Linux: The AIX compatible + # one and the ELFv2 one. The latter defines _CALL_ELF=2. + AC_COMPILE_IFELSE( + [AC_LANG_SOURCE( + [[#if defined _CALL_ELF && _CALL_ELF == 2 + int ok; + #else + error fail + #endif + ]])], + [gl_cv_host_cpu_c_abi=powerpc64-elfv2], + [gl_cv_host_cpu_c_abi=powerpc64]) + ], + [gl_cv_host_cpu_c_abi=powerpc]) + ;; + + rs6000 ) + gl_cv_host_cpu_c_abi=powerpc + ;; + + riscv32 | riscv64 ) + # There are 2 architectures (with variants): rv32* and rv64*. + AC_COMPILE_IFELSE( + [AC_LANG_SOURCE( + [[#if __riscv_xlen == 64 + int ok; + #else + error fail + #endif + ]])], + [cpu=riscv64], + [cpu=riscv32]) + # There are 6 ABIs: ilp32, ilp32f, ilp32d, lp64, lp64f, lp64d. + # Size of 'long' and 'void *': + AC_COMPILE_IFELSE( + [AC_LANG_SOURCE( + [[#if defined __LP64__ + int ok; + #else + error fail + #endif + ]])], + [main_abi=lp64], + [main_abi=ilp32]) + # Float ABIs: + # __riscv_float_abi_double: + # 'float' and 'double' are passed in floating-point registers. + # __riscv_float_abi_single: + # 'float' are passed in floating-point registers. + # __riscv_float_abi_soft: + # No values are passed in floating-point registers. + AC_COMPILE_IFELSE( + [AC_LANG_SOURCE( + [[#if defined __riscv_float_abi_double + int ok; + #else + error fail + #endif + ]])], + [float_abi=d], + [AC_COMPILE_IFELSE( + [AC_LANG_SOURCE( + [[#if defined __riscv_float_abi_single + int ok; + #else + error fail + #endif + ]])], + [float_abi=f], + [float_abi='']) + ]) + gl_cv_host_cpu_c_abi="${cpu}-${main_abi}${float_abi}" + ;; + + s390* ) + # On s390x, the C compiler may be generating 64-bit (= s390x) code + # or 31-bit (= s390) code. + AC_COMPILE_IFELSE( + [AC_LANG_SOURCE( + [[#if defined __LP64__ || defined __s390x__ + int ok; + #else + error fail + #endif + ]])], + [gl_cv_host_cpu_c_abi=s390x], + [gl_cv_host_cpu_c_abi=s390]) + ;; + + sparc | sparc64 ) + # UltraSPARCs running Linux have `uname -m` = "sparc64", but the + # C compiler still generates 32-bit code. + AC_COMPILE_IFELSE( + [AC_LANG_SOURCE( + [[#if defined __sparcv9 || defined __arch64__ + int ok; + #else + error fail + #endif + ]])], + [gl_cv_host_cpu_c_abi=sparc64], + [gl_cv_host_cpu_c_abi=sparc]) + ;; + + *) + gl_cv_host_cpu_c_abi="$host_cpu" + ;; + esac + ]) + + dnl In most cases, $HOST_CPU and $HOST_CPU_C_ABI are the same. + HOST_CPU=`echo "$gl_cv_host_cpu_c_abi" | sed -e 's/-.*//'` + HOST_CPU_C_ABI="$gl_cv_host_cpu_c_abi" + AC_SUBST([HOST_CPU]) + AC_SUBST([HOST_CPU_C_ABI]) + + # This was + # AC_DEFINE_UNQUOTED([__${HOST_CPU}__]) + # AC_DEFINE_UNQUOTED([__${HOST_CPU_C_ABI}__]) + # earlier, but KAI C++ 3.2d doesn't like this. + sed -e 's/-/_/g' >> confdefs.h < /* for exit() */ -#include -#if !(defined _WIN32 && !defined __CYGWIN__) -#include /* for _exit() */ -#endif - -static void -sigfpe_handler (int sig) -{ - /* Exit with code 0 if SIGFPE, with code 1 if any other signal. */ - _exit (sig != SIGFPE); -} - -int x = 1; -int y = 0; -int z; -int nan; - -int main () -{ - signal (SIGFPE, sigfpe_handler); -/* IRIX and AIX (when "xlc -qcheck" is used) yield signal SIGTRAP. */ -#if (defined (__sgi) || defined (_AIX)) && defined (SIGTRAP) - signal (SIGTRAP, sigfpe_handler); -#endif -/* Linux/SPARC yields signal SIGILL. */ -#if defined (__sparc__) && defined (__linux__) - signal (SIGILL, sigfpe_handler); -#endif - - z = x / y; - nan = y / y; - exit (2); -} -]])], - [gt_cv_int_divbyzero_sigfpe=yes], - [gt_cv_int_divbyzero_sigfpe=no], - [ - # Guess based on the CPU. -changequote(,)dnl - case "$host_cpu" in - alpha* | i[34567]86 | x86_64 | m68k | s390*) - gt_cv_int_divbyzero_sigfpe="guessing yes";; - *) - gt_cv_int_divbyzero_sigfpe="guessing no";; - esac -changequote([,])dnl - ]) - fi - ]) - case "$gt_cv_int_divbyzero_sigfpe" in - *yes) value=1;; - *) value=0;; - esac - AC_DEFINE_UNQUOTED([INTDIV0_RAISES_SIGFPE], [$value], - [Define if integer division by zero raises signal SIGFPE.]) -]) diff --git a/m4/intl-thread-locale.m4 b/m4/intl-thread-locale.m4 new file mode 100644 index 000000000..91a1c2089 --- /dev/null +++ b/m4/intl-thread-locale.m4 @@ -0,0 +1,256 @@ +# intl-thread-locale.m4 +# serial 15 +dnl Copyright (C) 2015-2025 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. +dnl This file is offered as-is, without any warranty. +dnl +dnl This file can be used in projects which are not available under +dnl the GNU General Public License or the GNU Lesser General Public +dnl License but which still want to provide support for the GNU gettext +dnl functionality. +dnl Please note that the actual code of the GNU gettext library is covered +dnl by the GNU Lesser General Public License, and the rest of the GNU +dnl gettext package is covered by the GNU General Public License. +dnl They are *not* in the public domain. + +dnl Check how to retrieve the name of a per-thread locale (POSIX locale_t). +dnl Sets gt_nameless_locales. +AC_DEFUN([gt_INTL_THREAD_LOCALE_NAME], +[ + AC_REQUIRE([AC_CANONICAL_HOST]) + + dnl Persuade Solaris to define 'locale_t'. + AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) + + dnl Test whether uselocale() exists and works at all. + gt_FUNC_USELOCALE + + dnl On OpenBSD >= 6.2, the locale_t type and the uselocale(), newlocale(), + dnl duplocale(), freelocale() functions exist but are effectively useless, + dnl because the locale_t value depends only on the LC_CTYPE category of the + dnl locale and furthermore contains only one bit of information (it + dnl distinguishes the "C" locale from the *.UTF-8 locales). See + dnl . + dnl In the setlocale() implementation they have thought about the programs + dnl that use the API ("Even though only LC_CTYPE has any effect in the + dnl OpenBSD base system, store complete information about the global locale, + dnl such that third-party software can access it"), but for uselocale() + dnl they did not think about the programs. + dnl In this situation, even the HAVE_NAMELESS_LOCALES support cannot make + dnl uselocale() work. + dnl Similarly on Android. See + dnl . + dnl So, define HAVE_FAKE_LOCALES and disable all per-thread locale support. + dnl Expected result: + dnl - HAVE_FAKE_LOCALES is defined on OpenBSD ≥ 6.2, Android API level >= 21. + case "$gt_cv_func_uselocale_works" in + *yes) + AC_CHECK_HEADERS_ONCE([xlocale.h]) + AC_CACHE_CHECK([for fake locale system (OpenBSD, Android)], + [gt_cv_locale_fake], + [case "$host_os" in + *-android*) gt_cv_locale_fake=yes ;; + *) + AC_RUN_IFELSE( + [AC_LANG_SOURCE([[ +#include +#if HAVE_XLOCALE_H +# include +#endif +int main () +{ + locale_t loc1, loc2; + if (setlocale (LC_ALL, "de_DE.UTF-8") == NULL) return 1; + if (setlocale (LC_ALL, "fr_FR.UTF-8") == NULL) return 1; + loc1 = newlocale (LC_ALL_MASK, "de_DE.UTF-8", (locale_t)0); + loc2 = newlocale (LC_ALL_MASK, "fr_FR.UTF-8", (locale_t)0); + return !(loc1 == loc2); +}]])], + [gt_cv_locale_fake=yes], + [gt_cv_locale_fake=no], + [dnl Guess the locale system is fake only on OpenBSD. + case "$host_os" in + openbsd*) gt_cv_locale_fake="guessing yes" ;; + *) gt_cv_locale_fake="guessing no" ;; + esac + ]) + ;; + esac + ]) + ;; + *) gt_cv_locale_fake=no ;; + esac + case "$gt_cv_locale_fake" in + *yes) + gt_fake_locales=yes + AC_DEFINE([HAVE_FAKE_LOCALES], [1], + [Define if the locale_t type contains insufficient information, as on OpenBSD.]) + ;; + *) + gt_fake_locales=no + ;; + esac + + dnl Expected result: HAVE_SOLARIS114_LOCALES is defined on Solaris ≥ 11.4. + case "$gt_cv_func_uselocale_works" in + *yes) + AC_CACHE_CHECK([for Solaris 11.4 locale system], + [gt_cv_locale_solaris114], + [case "$host_os" in + solaris*) + dnl Test whether defines locale_t as a typedef of + dnl 'struct _LC_locale_t **' (whereas Illumos defines it as a + dnl typedef of 'struct _locale *'). + dnl Another possible test would be to include + dnl and test whether it defines the _LC_core_data_locale_t type. + dnl This type was added in Solaris 11.4. + AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[ + #include + struct _LC_locale_t *x; + locale_t y; + ]], + [[*y = x;]])], + [gt_cv_locale_solaris114=yes], + [gt_cv_locale_solaris114=no]) + ;; + *) gt_cv_locale_solaris114=no ;; + esac + ]) + ;; + *) gt_cv_locale_solaris114=no ;; + esac + if test $gt_cv_locale_solaris114 = yes; then + AC_DEFINE([HAVE_SOLARIS114_LOCALES], [1], + [Define if the locale_t type is as on Solaris 11.4.]) + fi + + dnl This code is for platforms where the locale_t type does not provide access + dnl to the name of each locale category. This code has the drawback that it + dnl requires the gnulib overrides of 'newlocale', 'duplocale', 'freelocale', + dnl which is a problem for GNU libunistring. Therefore try hard to avoid + dnl enabling this code! + dnl Expected result: + dnl - HAVE_NAMELESS_LOCALES is defined on OpenBSD ≥ 6.2, AIX, + dnl Android API level >= 21, + dnl - HAVE_AIX72_LOCALES is defined on AIX ≥ 7.2. + gt_nameless_locales=$gt_fake_locales + case "$host_os" in + dnl It's needed on AIX 7.2. + aix*) + gt_nameless_locales=yes + dnl In AIX ≥ 7.2, a locale contains at least the name of the LC_MESSAGES + dnl category (fix of defect 823926). + AC_CACHE_CHECK([for AIX locales with LC_MESSAGES name], + [gt_cv_locale_aix72], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[ + #include + /* Include , which defines __locale_t. */ + #include + locale_t x; + ]], + [[return ((__locale_t) x)->locale_name[0];]])], + [gt_cv_locale_aix72=yes], + [gt_cv_locale_aix72=no]) + ]) + if test $gt_cv_locale_aix72 = yes; then + AC_DEFINE([HAVE_AIX72_LOCALES], [1], + [Define if the __locale_t type contains the name of the LC_MESSAGES category.]) + fi + ;; + esac + if test $gt_nameless_locales = yes; then + AC_DEFINE([HAVE_NAMELESS_LOCALES], [1], + [Define if the locale_t type does not contain the name of each locale category.]) + fi + + dnl We cannot support uselocale() on platforms where the locale_t type is + dnl fake. So, set + dnl gt_good_uselocale = gt_working_uselocale && !gt_fake_locales. + dnl Expected result: HAVE_GOOD_USELOCALE is defined on all platforms except + dnl FreeBSD < 9.1, NetBSD, OpenBSD, Minix, AIX < 7, AIX 7.2, HP-UX, IRIX, + dnl Solaris < 11.4, Cygwin < 2.6, mingw, MSVC 14, Android. + if test $gt_working_uselocale = yes && test $gt_fake_locales = no; then + gt_good_uselocale=yes + AC_DEFINE([HAVE_GOOD_USELOCALE], [1], + [Define if the uselocale function exists, may be safely called, and returns sufficient information.]) + else + gt_good_uselocale=no + fi + + dnl Set gt_localename_enhances_locale_funcs to indicate whether localename.c + dnl overrides newlocale(), duplocale(), freelocale() to keep track of locale + dnl names. + dnl Expected result: LOCALENAME_ENHANCE_LOCALE_FUNCS is defined on + dnl OpenBSD ≥ 6.2, AIX 7.1, AIX ≥ 7.3, Android API level >= 21. + if test $gt_working_uselocale = yes && test $gt_nameless_locales = yes; then + gt_localename_enhances_locale_funcs=yes + LOCALENAME_ENHANCE_LOCALE_FUNCS=1 + AC_DEFINE([LOCALENAME_ENHANCE_LOCALE_FUNCS], [1], + [Define if localename.c overrides newlocale(), duplocale(), freelocale().]) + else + gt_localename_enhances_locale_funcs=no + fi +]) + +dnl Tests whether uselocale() exists and is usable. +dnl Sets gt_working_uselocale and defines HAVE_WORKING_USELOCALE. +dnl Expected result: HAVE_WORKING_USELOCALE is defined on all platforms except +dnl FreeBSD < 9.1, NetBSD, OpenBSD < 6.2, Minix, AIX < 7, AIX 7.2, HP-UX, IRIX, +dnl Solaris < 11.4, Cygwin < 2.6, mingw, MSVC 14, Android API level < 21. +AC_DEFUN([gt_FUNC_USELOCALE], +[ + AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles + + dnl Persuade glibc and Solaris to define 'locale_t'. + AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) + + gl_CHECK_FUNCS_ANDROID([uselocale], [[#include ]]) + + dnl On AIX 7.2, the uselocale() function is not documented and leads to + dnl crashes in subsequent setlocale() invocations. + dnl In 2019, some versions of z/OS lack the locale_t type and have a broken + dnl uselocale function. + if test $ac_cv_func_uselocale = yes; then + AC_CHECK_HEADERS_ONCE([xlocale.h]) + AC_CACHE_CHECK([whether uselocale works], + [gt_cv_func_uselocale_works], + [AC_RUN_IFELSE( + [AC_LANG_SOURCE([[ +#include +#if HAVE_XLOCALE_H +# include +#endif +locale_t loc1; +int main () +{ + uselocale (NULL); + setlocale (LC_ALL, "en_US.UTF-8"); + return 0; +}]])], + [gt_cv_func_uselocale_works=yes], + [gt_cv_func_uselocale_works=no], + [# Guess no on AIX and z/OS, yes otherwise. + case "$host_os" in + aix* | openedition*) gt_cv_func_uselocale_works="guessing no" ;; + *) gt_cv_func_uselocale_works="guessing yes" ;; + esac + ]) + ]) + else + gt_cv_func_uselocale_works=no + fi + case "$gt_cv_func_uselocale_works" in + *yes) + gt_working_uselocale=yes + AC_DEFINE([HAVE_WORKING_USELOCALE], [1], + [Define if the uselocale function exists and may safely be called.]) + ;; + *) + gt_working_uselocale=no + ;; + esac +]) diff --git a/m4/intl.m4 b/m4/intl.m4 deleted file mode 100644 index 4147309b9..000000000 --- a/m4/intl.m4 +++ /dev/null @@ -1,288 +0,0 @@ -# intl.m4 serial 43 (gettext-0.21) -dnl Copyright (C) 1995-2014, 2016-2020 Free Software Foundation, Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. -dnl -dnl This file can be used in projects which are not available under -dnl the GNU General Public License or the GNU Lesser General Public -dnl License but which still want to provide support for the GNU gettext -dnl functionality. -dnl Please note that the actual code of the GNU gettext library is covered -dnl by the GNU Lesser General Public License, and the rest of the GNU -dnl gettext package is covered by the GNU General Public License. -dnl They are *not* in the public domain. - -dnl Authors: -dnl Ulrich Drepper , 1995-2000. -dnl Bruno Haible , 2000-2009. - -AC_PREREQ([2.60]) - -dnl Checks for all prerequisites of the intl subdirectory, -dnl except for LIBTOOL, USE_INCLUDED_LIBINTL, BUILD_INCLUDED_LIBINTL. -AC_DEFUN([AM_INTL_SUBDIR], -[ - AC_REQUIRE([AC_PROG_INSTALL])dnl - AC_REQUIRE([AC_PROG_MKDIR_P])dnl - AC_REQUIRE([AC_PROG_CC])dnl - AC_REQUIRE([AC_CANONICAL_HOST])dnl - AC_REQUIRE([gt_GLIBC2])dnl - AC_REQUIRE([gl_VISIBILITY])dnl - AC_REQUIRE([gt_INTL_SUBDIR_CORE])dnl - AC_REQUIRE([AC_TYPE_LONG_LONG_INT])dnl - AC_REQUIRE([gt_TYPE_WCHAR_T])dnl - AC_REQUIRE([gt_TYPE_WINT_T])dnl - AC_REQUIRE([gl_AC_HEADER_INTTYPES_H]) - AC_REQUIRE([gt_TYPE_INTMAX_T]) - AC_REQUIRE([gt_PRINTF_POSIX]) - AC_REQUIRE([gl_GLIBC21])dnl - AC_REQUIRE([gl_XSIZE])dnl - AC_REQUIRE([gl_FCNTL_O_FLAGS])dnl - AC_REQUIRE([gt_INTL_THREAD_LOCALE_NAME]) - AC_REQUIRE([gt_INTL_MACOSX])dnl - AC_REQUIRE([gl_EXTERN_INLINE])dnl - AC_REQUIRE([gt_GL_ATTRIBUTE])dnl - AC_REQUIRE([AC_C_FLEXIBLE_ARRAY_MEMBER])dnl - - dnl In projects that use gnulib, use gl_PROG_AR_RANLIB. - dnl The '][' hides this use from 'aclocal'. - m4_ifdef([g][l_PROG_AR_RANLIB], - [AC_REQUIRE([g][l_PROG_AR_RANLIB])], - [AC_REQUIRE([AC_PROG_RANLIB]) - dnl Use Automake-documented default values for AR and ARFLAGS, but prefer - dnl ${host}-ar over ar (useful for cross-compiling). - AC_CHECK_TOOL([AR], [ar], [ar]) - if test -z "$ARFLAGS"; then - ARFLAGS='cr' - fi - AC_SUBST([AR]) - AC_SUBST([ARFLAGS]) - ]) - - dnl Support for automake's --enable-silent-rules. - case "$enable_silent_rules" in - yes) INTL_DEFAULT_VERBOSITY=0;; - no) INTL_DEFAULT_VERBOSITY=1;; - *) INTL_DEFAULT_VERBOSITY=1;; - esac - AC_SUBST([INTL_DEFAULT_VERBOSITY]) - - AC_CHECK_TYPE([ptrdiff_t], , - [AC_DEFINE([ptrdiff_t], [long], - [Define as the type of the result of subtracting two pointers, if the system doesn't define it.]) - ]) - AC_CHECK_HEADERS([features.h stddef.h stdlib.h string.h]) - AC_CHECK_FUNCS([asprintf wprintf newlocale putenv setenv \ - snprintf strnlen uselocale wcslen wcsnlen mbrtowc wcrtomb]) - - dnl Use the _snprintf function only if it is declared (because on NetBSD it - dnl is defined as a weak alias of snprintf; we prefer to use the latter). - AC_CHECK_DECLS([_snprintf, _snwprintf], , , [#include ]) - - dnl Use the *_unlocked functions only if they are declared. - dnl (because some of them were defined without being declared in Solaris - dnl 2.5.1 but were removed in Solaris 2.6, whereas we want binaries built - dnl on Solaris 2.5.1 to run on Solaris 2.6). - AC_CHECK_DECLS([getc_unlocked], , , [#include ]) - - case $gt_cv_func_printf_posix in - *yes) HAVE_POSIX_PRINTF=1 ;; - *) HAVE_POSIX_PRINTF=0 ;; - esac - AC_SUBST([HAVE_POSIX_PRINTF]) - if test "$ac_cv_func_asprintf" = yes; then - HAVE_ASPRINTF=1 - else - HAVE_ASPRINTF=0 - fi - AC_SUBST([HAVE_ASPRINTF]) - if test "$ac_cv_func_snprintf" = yes; then - HAVE_SNPRINTF=1 - else - HAVE_SNPRINTF=0 - fi - AC_SUBST([HAVE_SNPRINTF]) - if test "$ac_cv_func_newlocale" = yes; then - HAVE_NEWLOCALE=1 - else - HAVE_NEWLOCALE=0 - fi - AC_SUBST([HAVE_NEWLOCALE]) - if test "$ac_cv_func_wprintf" = yes; then - HAVE_WPRINTF=1 - else - HAVE_WPRINTF=0 - fi - AC_SUBST([HAVE_WPRINTF]) - - AM_LANGINFO_CODESET - gt_LC_MESSAGES - - if test $gt_nameless_locales = yes; then - HAVE_NAMELESS_LOCALES=1 - else - HAVE_NAMELESS_LOCALES=0 - fi - AC_SUBST([HAVE_NAMELESS_LOCALES]) - - dnl Compilation on mingw and Cygwin needs special Makefile rules, because - dnl 1. when we install a shared library, we must arrange to export - dnl auxiliary pointer variables for every exported variable, - dnl 2. when we install a shared library and a static library simultaneously, - dnl the include file specifies __declspec(dllimport) and therefore we - dnl must arrange to define the auxiliary pointer variables for the - dnl exported variables _also_ in the static library. - if test "$enable_shared" = yes; then - case "$host_os" in - mingw* | cygwin*) is_woe32dll=yes ;; - *) is_woe32dll=no ;; - esac - else - is_woe32dll=no - fi - WOE32DLL=$is_woe32dll - AC_SUBST([WOE32DLL]) - - dnl On mingw and Cygwin, we can activate special Makefile rules which add - dnl version information to the shared libraries and executables. - case "$host_os" in - mingw* | cygwin*) is_woe32=yes ;; - *) is_woe32=no ;; - esac - WOE32=$is_woe32 - AC_SUBST([WOE32]) - if test $WOE32 = yes; then - dnl Check for a program that compiles Windows resource files. - AC_CHECK_TOOL([WINDRES], [windres]) - fi - - dnl Rename some macros and functions used for locking. - AH_BOTTOM([ -#define __libc_lock_t gl_lock_t -#define __libc_lock_define gl_lock_define -#define __libc_lock_define_initialized gl_lock_define_initialized -#define __libc_lock_init gl_lock_init -#define __libc_lock_lock gl_lock_lock -#define __libc_lock_unlock gl_lock_unlock -#define __libc_lock_recursive_t gl_recursive_lock_t -#define __libc_lock_define_recursive gl_recursive_lock_define -#define __libc_lock_define_initialized_recursive gl_recursive_lock_define_initialized -#define __libc_lock_init_recursive gl_recursive_lock_init -#define __libc_lock_lock_recursive gl_recursive_lock_lock -#define __libc_lock_unlock_recursive gl_recursive_lock_unlock -#define glthread_in_use libintl_thread_in_use -#define glthread_lock_init_func libintl_lock_init_func -#define glthread_lock_lock_func libintl_lock_lock_func -#define glthread_lock_unlock_func libintl_lock_unlock_func -#define glthread_lock_destroy_func libintl_lock_destroy_func -#define glthread_rwlock_init_multithreaded libintl_rwlock_init_multithreaded -#define glthread_rwlock_init_func libintl_rwlock_init_func -#define glthread_rwlock_rdlock_multithreaded libintl_rwlock_rdlock_multithreaded -#define glthread_rwlock_rdlock_func libintl_rwlock_rdlock_func -#define glthread_rwlock_wrlock_multithreaded libintl_rwlock_wrlock_multithreaded -#define glthread_rwlock_wrlock_func libintl_rwlock_wrlock_func -#define glthread_rwlock_unlock_multithreaded libintl_rwlock_unlock_multithreaded -#define glthread_rwlock_unlock_func libintl_rwlock_unlock_func -#define glthread_rwlock_destroy_multithreaded libintl_rwlock_destroy_multithreaded -#define glthread_rwlock_destroy_func libintl_rwlock_destroy_func -#define glthread_recursive_lock_init_multithreaded libintl_recursive_lock_init_multithreaded -#define glthread_recursive_lock_init_func libintl_recursive_lock_init_func -#define glthread_recursive_lock_lock_multithreaded libintl_recursive_lock_lock_multithreaded -#define glthread_recursive_lock_lock_func libintl_recursive_lock_lock_func -#define glthread_recursive_lock_unlock_multithreaded libintl_recursive_lock_unlock_multithreaded -#define glthread_recursive_lock_unlock_func libintl_recursive_lock_unlock_func -#define glthread_recursive_lock_destroy_multithreaded libintl_recursive_lock_destroy_multithreaded -#define glthread_recursive_lock_destroy_func libintl_recursive_lock_destroy_func -#define glthread_once_func libintl_once_func -#define glthread_once_singlethreaded libintl_once_singlethreaded -#define glthread_once_multithreaded libintl_once_multithreaded -]) -]) - - -dnl Checks for the core files of the intl subdirectory: -dnl dcigettext.c -dnl eval-plural.h -dnl explodename.c -dnl finddomain.c -dnl gettextP.h -dnl gmo.h -dnl hash-string.h hash-string.c -dnl l10nflist.c -dnl libgnuintl.h.in (except the *printf stuff) -dnl loadinfo.h -dnl loadmsgcat.c -dnl localealias.c -dnl log.c -dnl plural-exp.h plural-exp.c -dnl plural.y -dnl Used by libglocale. -AC_DEFUN([gt_INTL_SUBDIR_CORE], -[ - AC_REQUIRE([AC_C_INLINE])dnl - AC_REQUIRE([AC_TYPE_SIZE_T])dnl - AC_REQUIRE([gl_AC_HEADER_STDINT_H]) - AC_REQUIRE([AC_FUNC_ALLOCA])dnl - AC_REQUIRE([AC_FUNC_MMAP])dnl - AC_REQUIRE([gt_INTDIV0])dnl - AC_REQUIRE([gl_AC_TYPE_UINTMAX_T])dnl - AC_REQUIRE([gt_INTTYPES_PRI])dnl - AC_REQUIRE([gl_LOCK])dnl - - AC_LINK_IFELSE( - [AC_LANG_PROGRAM( - [[int foo (int a) { a = __builtin_expect (a, 10); return a == 10 ? 0 : 1; }]], - [[]])], - [AC_DEFINE([HAVE_BUILTIN_EXPECT], [1], - [Define to 1 if the compiler understands __builtin_expect.])]) - - AC_CHECK_HEADERS([inttypes.h limits.h unistd.h sys/param.h]) - AC_CHECK_FUNCS([getcwd getegid geteuid getgid getuid mempcpy munmap \ - stpcpy strcasecmp strdup strtoul tsearch __fsetlocking]) - - dnl Use the *_unlocked functions only if they are declared. - dnl (because some of them were defined without being declared in Solaris - dnl 2.5.1 but were removed in Solaris 2.6, whereas we want binaries built - dnl on Solaris 2.5.1 to run on Solaris 2.6). - AC_CHECK_DECLS([feof_unlocked, fgets_unlocked], , , [#include ]) - - AM_ICONV - - dnl intl/plural.c is generated from intl/plural.y. It requires bison, - dnl because plural.y uses bison specific features. It requires at least - dnl bison-3.0 for %precedence. - dnl bison is only needed for the maintainer (who touches plural.y). But in - dnl order to avoid separate Makefiles or --enable-maintainer-mode, we put - dnl the rule in general Makefile. Now, some people carelessly touch the - dnl files or have a broken "make" program, hence the plural.c rule will - dnl sometimes fire. To avoid an error, defines BISON to ":" if it is not - dnl present or too old. - gl_PROG_BISON([INTLBISON], [3.0]) -]) - -dnl Copies _GL_UNUSED and _GL_ATTRIBUTE_PURE definitions from -dnl gnulib-common.m4 as a fallback, if the project isn't using Gnulib. -AC_DEFUN([gt_GL_ATTRIBUTE], [ - m4_ifndef([gl_[]COMMON], - AH_VERBATIM([gt_gl_attribute], -[/* Define as a marker that can be attached to declarations that might not - be used. This helps to reduce warnings, such as from - GCC -Wunused-parameter. */ -#ifndef _GL_UNUSED -# if __GNUC__ >= 3 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7) -# define _GL_UNUSED __attribute__ ((__unused__)) -# else -# define _GL_UNUSED -# endif -#endif - -/* The __pure__ attribute was added in gcc 2.96. */ -#ifndef _GL_ATTRIBUTE_PURE -# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96) -# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__)) -# else -# define _GL_ATTRIBUTE_PURE /* empty */ -# endif -#endif -]))]) diff --git a/m4/intldir.m4 b/m4/intldir.m4 deleted file mode 100644 index c688f4695..000000000 --- a/m4/intldir.m4 +++ /dev/null @@ -1,19 +0,0 @@ -# intldir.m4 serial 2 (gettext-0.18) -dnl Copyright (C) 2006, 2009-2014, 2016 Free Software Foundation, Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. -dnl -dnl This file can be used in projects which are not available under -dnl the GNU General Public License or the GNU Library General Public -dnl License but which still want to provide support for the GNU gettext -dnl functionality. -dnl Please note that the actual code of the GNU gettext library is covered -dnl by the GNU Library General Public License, and the rest of the GNU -dnl gettext package is covered by the GNU General Public License. -dnl They are *not* in the public domain. - -AC_PREREQ([2.52]) - -dnl Tells the AM_GNU_GETTEXT macro to consider an intl/ directory. -AC_DEFUN([AM_GNU_GETTEXT_INTL_SUBDIR], []) diff --git a/m4/intlmacosx.m4 b/m4/intlmacosx.m4 index ebd9937c1..f0920d0ff 100644 --- a/m4/intlmacosx.m4 +++ b/m4/intlmacosx.m4 @@ -1,8 +1,10 @@ -# intlmacosx.m4 serial 8 (gettext-0.20.2) -dnl Copyright (C) 2004-2014, 2016, 2019-2020 Free Software Foundation, Inc. +# intlmacosx.m4 +# serial 10 (gettext-0.23) +dnl Copyright (C) 2004-2014, 2016, 2019-2025 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. +dnl This file is offered as-is, without any warranty. dnl dnl This file can be used in projects which are not available under dnl the GNU General Public License or the GNU Lesser General Public @@ -20,7 +22,7 @@ AC_DEFUN([gt_INTL_MACOSX], dnl Check for API introduced in Mac OS X 10.4. AC_CACHE_CHECK([for CFPreferencesCopyAppValue], [gt_cv_func_CFPreferencesCopyAppValue], - [gt_save_LIBS="$LIBS" + [gt_saved_LIBS="$LIBS" LIBS="$LIBS -Wl,-framework -Wl,CoreFoundation" AC_LINK_IFELSE( [AC_LANG_PROGRAM( @@ -28,7 +30,7 @@ AC_DEFUN([gt_INTL_MACOSX], [[CFPreferencesCopyAppValue(NULL, NULL)]])], [gt_cv_func_CFPreferencesCopyAppValue=yes], [gt_cv_func_CFPreferencesCopyAppValue=no]) - LIBS="$gt_save_LIBS"]) + LIBS="$gt_saved_LIBS"]) if test $gt_cv_func_CFPreferencesCopyAppValue = yes; then AC_DEFINE([HAVE_CFPREFERENCESCOPYAPPVALUE], [1], [Define to 1 if you have the Mac OS X function CFPreferencesCopyAppValue in the CoreFoundation framework.]) @@ -43,7 +45,7 @@ AC_DEFUN([gt_INTL_MACOSX], dnl CFPreferencesCopyAppValue still returns, namely ll_CC where ll is the dnl first among the preferred languages and CC is the territory. AC_CACHE_CHECK([for CFLocaleCopyPreferredLanguages], [gt_cv_func_CFLocaleCopyPreferredLanguages], - [gt_save_LIBS="$LIBS" + [gt_saved_LIBS="$LIBS" LIBS="$LIBS -Wl,-framework -Wl,CoreFoundation" AC_LINK_IFELSE( [AC_LANG_PROGRAM( @@ -51,7 +53,7 @@ AC_DEFUN([gt_INTL_MACOSX], [[CFLocaleCopyPreferredLanguages();]])], [gt_cv_func_CFLocaleCopyPreferredLanguages=yes], [gt_cv_func_CFLocaleCopyPreferredLanguages=no]) - LIBS="$gt_save_LIBS"]) + LIBS="$gt_saved_LIBS"]) if test $gt_cv_func_CFLocaleCopyPreferredLanguages = yes; then AC_DEFINE([HAVE_CFLOCALECOPYPREFERREDLANGUAGES], [1], [Define to 1 if you have the Mac OS X function CFLocaleCopyPreferredLanguages in the CoreFoundation framework.]) @@ -59,7 +61,11 @@ AC_DEFUN([gt_INTL_MACOSX], INTL_MACOSX_LIBS= if test $gt_cv_func_CFPreferencesCopyAppValue = yes \ || test $gt_cv_func_CFLocaleCopyPreferredLanguages = yes; then - INTL_MACOSX_LIBS="-Wl,-framework -Wl,CoreFoundation" + dnl Starting with macOS version 14, CoreFoundation relies on CoreServices, + dnl and we have to link it in explicitly, otherwise an exception + dnl NSInvalidArgumentException "unrecognized selector sent to instance" + dnl occurs. + INTL_MACOSX_LIBS="-Wl,-framework -Wl,CoreFoundation -Wl,-framework -Wl,CoreServices" fi AC_SUBST([INTL_MACOSX_LIBS]) ]) diff --git a/m4/intmax.m4 b/m4/intmax.m4 deleted file mode 100644 index 1a47107f1..000000000 --- a/m4/intmax.m4 +++ /dev/null @@ -1,36 +0,0 @@ -# intmax.m4 serial 6 (gettext-0.18.2) -dnl Copyright (C) 2002-2005, 2008-2016 Free Software Foundation, Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. - -dnl From Bruno Haible. -dnl Test whether the system has the 'intmax_t' type, but don't attempt to -dnl find a replacement if it is lacking. - -AC_DEFUN([gt_TYPE_INTMAX_T], -[ - AC_REQUIRE([gl_AC_HEADER_INTTYPES_H]) - AC_REQUIRE([gl_AC_HEADER_STDINT_H]) - AC_CACHE_CHECK([for intmax_t], [gt_cv_c_intmax_t], - [AC_COMPILE_IFELSE( - [AC_LANG_PROGRAM( - [[ -#include -#include -#if HAVE_STDINT_H_WITH_UINTMAX -#include -#endif -#if HAVE_INTTYPES_H_WITH_UINTMAX -#include -#endif - ]], - [[intmax_t x = -1; - return !x;]])], - [gt_cv_c_intmax_t=yes], - [gt_cv_c_intmax_t=no])]) - if test $gt_cv_c_intmax_t = yes; then - AC_DEFINE([HAVE_INTMAX_T], [1], - [Define if you have the 'intmax_t' type in or .]) - fi -]) diff --git a/m4/progtest.m4 b/m4/progtest.m4 index f28010aed..8fb500d91 100644 --- a/m4/progtest.m4 +++ b/m4/progtest.m4 @@ -1,8 +1,10 @@ -# progtest.m4 serial 8 (gettext-0.20.2) -dnl Copyright (C) 1996-2003, 2005, 2008-2020 Free Software Foundation, Inc. +# progtest.m4 +# serial 11 (gettext-0.26) +dnl Copyright (C) 1996-2003, 2005, 2008-2025 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. +dnl This file is offered as-is, without any warranty. dnl dnl This file can be used in projects which are not available under dnl the GNU General Public License or the GNU Lesser General Public @@ -16,7 +18,7 @@ dnl They are *not* in the public domain. dnl Authors: dnl Ulrich Drepper , 1996. -AC_PREREQ([2.50]) +AC_PREREQ([2.53]) # Search path for a program which passes the given test. @@ -60,13 +62,13 @@ AC_CACHE_VAL([ac_cv_path_$1], ac_cv_path_$1="[$]$1" # Let the user override the test with a path. ;; *) - ac_save_IFS="$IFS"; IFS=$PATH_SEPARATOR - for ac_dir in ifelse([$5], , $PATH, [$5]); do - IFS="$ac_save_IFS" + gt_saved_IFS="$IFS"; IFS=$PATH_SEPARATOR + for ac_dir in m4_if([$5], , $PATH, [$5]); do + IFS="$gt_saved_IFS" test -z "$ac_dir" && ac_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $ac_executable_p "$ac_dir/$ac_word$ac_exec_ext"; then - echo "$as_me: trying $ac_dir/$ac_word..." >&AS_MESSAGE_LOG_FD + echo "$as_me:${as_lineno-$LINENO}: trying $ac_dir/$ac_word..." >&AS_MESSAGE_LOG_FD if [$3]; then ac_cv_path_$1="$ac_dir/$ac_word$ac_exec_ext" break 2 @@ -74,15 +76,15 @@ AC_CACHE_VAL([ac_cv_path_$1], fi done done - IFS="$ac_save_IFS" + IFS="$gt_saved_IFS" dnl If no 4th arg is given, leave the cache variable unset, dnl so AC_PATH_PROGS will keep looking. -ifelse([$4], , , [ test -z "[$]ac_cv_path_$1" && ac_cv_path_$1="$4" +m4_if([$4], , , [ test -z "[$]ac_cv_path_$1" && ac_cv_path_$1="$4" ])dnl ;; esac])dnl $1="$ac_cv_path_$1" -if test ifelse([$4], , [-n "[$]$1"], ["[$]$1" != "$4"]); then +if test m4_if([$4], , [-n "[$]$1"], ["[$]$1" != "$4"]); then AC_MSG_RESULT([$][$1]) else AC_MSG_RESULT([no]) diff --git a/m4/uintmax_t.m4 b/m4/uintmax_t.m4 deleted file mode 100644 index 30f4dd5d1..000000000 --- a/m4/uintmax_t.m4 +++ /dev/null @@ -1,30 +0,0 @@ -# uintmax_t.m4 serial 12 -dnl Copyright (C) 1997-2004, 2007-2016 Free Software Foundation, Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. - -dnl From Paul Eggert. - -AC_PREREQ([2.13]) - -# Define uintmax_t to 'unsigned long' or 'unsigned long long' -# if it is not already defined in or . - -AC_DEFUN([gl_AC_TYPE_UINTMAX_T], -[ - AC_REQUIRE([gl_AC_HEADER_INTTYPES_H]) - AC_REQUIRE([gl_AC_HEADER_STDINT_H]) - if test $gl_cv_header_inttypes_h = no && test $gl_cv_header_stdint_h = no; then - AC_REQUIRE([AC_TYPE_UNSIGNED_LONG_LONG_INT]) - test $ac_cv_type_unsigned_long_long_int = yes \ - && ac_type='unsigned long long' \ - || ac_type='unsigned long' - AC_DEFINE_UNQUOTED([uintmax_t], [$ac_type], - [Define to unsigned long or unsigned long long - if and don't define.]) - else - AC_DEFINE([HAVE_UINTMAX_T], [1], - [Define if you have the 'uintmax_t' type in or .]) - fi -]) diff --git a/tests/testsuite.src/used_binaries.at b/tests/testsuite.src/used_binaries.at index 91a651e4b..e7016ac18 100644 --- a/tests/testsuite.src/used_binaries.at +++ b/tests/testsuite.src/used_binaries.at @@ -1115,7 +1115,7 @@ AT_DATA([prog2.cob], [ AT_DATA([filec.c], [ /* for COB_EXT_EXPORT */ #include -COB_EXT_EXPORT void f (char *str, long num) {}; +COB_EXT_EXPORT void f (char *str, long num) {} ]) AT_CHECK([$COMPILE_MODULE --save-temps filec.c -o libfilec.$COB_MODULE_EXT], [0], [], []) # cater for environments that do not use a lib prefix From 262686c35bc91ab687b290a9fbf66f25d58c1e20 Mon Sep 17 00:00:00 2001 From: David Declerck Date: Thu, 31 Jul 2025 15:50:23 +0200 Subject: [PATCH 7/7] Fix IBM CI target branch --- .github/workflows/ibm.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ibm.yml b/.github/workflows/ibm.yml index f73041725..7eae896b4 100644 --- a/.github/workflows/ibm.yml +++ b/.github/workflows/ibm.yml @@ -2,7 +2,7 @@ name: IBM Power & Z on: pull_request: - branches: [ gcos4gnucobol-3.x ] + branches: [ gc4 ] # manual run in actions tab - for all branches workflow_dispatch: