https://gcc.gnu.org/g:6e71afffd4c0a9a872790826920548edc3360173
commit r17-4721-g6e71afffd4c0a9a872790826920548edc3360173 Author: Xavier Del Campo Romero <[email protected]> Date: Thu Sep 24 14:51:44 2026 +0200 cobol: Fix return values for CBL_GET_PROGRAM_INFO The documentation defines a list of return values that were not being honored. Also, the behaviour for return-buf and return-buf-len was inconsistent with the specification. [1] [1]: https://docs.rocketsoftware.com/bundle/visualcoboldevhub_ug_110/page/lxm1742952203519.html libgcobol/ChangeLog: * compat/gnu/lib/cbl_get_program_info.3: Update to status quo. * compat/gnu/lib/cbl_gpi.cc (setbasename): Honor return values and return-buf{-len}. (cbl_gpi_cur_status): Likewise. (cbl_gpi_named_status): Likewise. (cbl_gpi_parent_status): Likewise. (cbl_gpi_close_handle): Likewise. (cbl_gpi_first_ep): Update function signature. (cbl_gpi_next_ep): Update function signature. (cbl_gpi_cancel_search_ep): Update function signature. (cbl_gpi_prg_name): Update function signature. (cbl_gpi_nargs): Update function signature. (cbl_gpi_reserved): Update function signature. (cbl_gpi_path_prg_name): Update function signature. (checkflags): Remove old debug messages. (cbl_gpi): Honor return values. gcc/testsuite/ChangeLog: * cobol.dg/group2/CBL_GET_PROGRAM_INFO__get_program_name_-_functions_0_and_2_.cob: Update test according to expected behaviour. Diff: --- ...INFO__get_program_name_-_functions_0_and_2_.cob | 6 +- libgcobol/compat/gnu/lib/cbl_get_program_info.3 | 59 +++++++++++-- libgcobol/compat/gnu/lib/cbl_gpi.cc | 99 +++++++++++----------- 3 files changed, 104 insertions(+), 60 deletions(-) diff --git a/gcc/testsuite/cobol.dg/group2/CBL_GET_PROGRAM_INFO__get_program_name_-_functions_0_and_2_.cob b/gcc/testsuite/cobol.dg/group2/CBL_GET_PROGRAM_INFO__get_program_name_-_functions_0_and_2_.cob index f26b70f39c27..9482c75a8d3c 100644 --- a/gcc/testsuite/cobol.dg/group2/CBL_GET_PROGRAM_INFO__get_program_name_-_functions_0_and_2_.cob +++ b/gcc/testsuite/cobol.dg/group2/CBL_GET_PROGRAM_INFO__get_program_name_-_functions_0_and_2_.cob @@ -41,8 +41,8 @@ copy "cbltypes.cpy". 01 param-block type cblt-prog-info-params. procedure division using param-block. - move length of buf to buflen. perform until status-code <> 0 + move length of buf to buflen * retrieve program name from handle move 6 to cblte-gpi-flags move 2 to fn @@ -59,6 +59,10 @@ end-if end-perform. + if status-code <> 500 + display "CBL_GET_PROGRAM_INFO failed with " status-code + end-if. + close-handle section. * close handle move 0 to cblte-gpi-flags. diff --git a/libgcobol/compat/gnu/lib/cbl_get_program_info.3 b/libgcobol/compat/gnu/lib/cbl_get_program_info.3 index d6b9a38b9bfb..ec35d14f5a57 100644 --- a/libgcobol/compat/gnu/lib/cbl_get_program_info.3 +++ b/libgcobol/compat/gnu/lib/cbl_get_program_info.3 @@ -38,9 +38,13 @@ and assign .Ar cblte-gpi-handle . .Ar 2 : -Return the program name associated with a +Return the +.Ar caller +program name associated with a .Ar cblte-gpi-handle instance previously allocated by function 0. +.Ar cblte-gpi-handle +is updated to the caller function. .Ar 3 : close a @@ -77,12 +81,6 @@ and is ignored by all other functions. fill .Ar return-buf with the program name. -.Ar return-buf-len -therefore indicates the length of the -.Ar return-buf -buffer. If the program name is longer than -.Ar return-buf-len , -the result is truncated. This bit is only relevant for functions .Ar 0 and @@ -99,15 +97,58 @@ points to a buffer to be filled by .Nm . .It Ar return-buf-len -determines the length for the +on entry, +.Ar return-buf-len +indicates the length of the .Ar return-buf -buffer. +buffer, +.Sy including +the terminator byte (nul or space). +On exit, +.Ar return-buf-len +is updated to the length of the program name, +.Sy excluding +the terminator byte. +However, if +.Ar return-buf-len +is too small, +.Ar return-buf +is left untouched and +.Ar return-buf-len +is updated to the required buffer length, +.Sy including +the terminator byte. .Sh RETURN STATUS .Nm returns .Sy "PIC X(2) COMP-5" . The return status is 0 on success, else nonzero. +The following return values are defined: + +.Ar 500 : +(function 2 only) no parent available from the call stack. + +.Ar 1001 : +invalid +.Ar cblte-gpi-handle . + +.Ar 1009 : +invalid parameter. + +.Ar 1011 : +invalid or undefined program name. +Additionally, +.Ar libgcobol_compat_gnu +uses this return value when no call stack was found for the given program. + +.Ar 1013 : +.Ar return-buf-len +is too small to write the function basename to +.Ar return-buf . +The required buffer length is therefore written to +.Ar return-buf-len . + . .Sh SEE ALSO .Xr CBL_CLOSE_FILE diff --git a/libgcobol/compat/gnu/lib/cbl_gpi.cc b/libgcobol/compat/gnu/lib/cbl_gpi.cc index 7708767fad73..4d414ba169a0 100644 --- a/libgcobol/compat/gnu/lib/cbl_gpi.cc +++ b/libgcobol/compat/gnu/lib/cbl_gpi.cc @@ -126,29 +126,41 @@ callstack() return ret; } -static void -setbasename(const std::string &src, const gpi_param_t &p, char *dst, unsigned n) +static int16_t +setbasename(const std::string &src, const gpi_param_t &p, char *dst, + unsigned *buflen) { - strncpy(dst, src.c_str(), n); + int r = snprintf(NULL, 0, "%s", src.c_str()); - if (n) + if (r < 0 || !dst || !buflen) + return 1009; + else if (r >= *buflen) { - dst[n - 1] = '\0'; + *buflen = r + 1; + return 1013; + } + else + { + *buflen = snprintf(dst, *buflen, "%s", src.c_str()); if (!(p.flags & GPI_PARAM_NULL_TERM)) dst[strlen(dst)] = ' '; } + + return 0; } int16_t -cbl_gpi_cur_status(gpi_param_t ¶ms, union retbuf buf, unsigned buflen) +cbl_gpi_cur_status(gpi_param_t ¶ms, union retbuf buf, unsigned *buflen) { + int16_t ret; std::vector<std::string> cs = callstack(); if (cs.empty()) - return -1; + return 1011; else if (params.flags & GPI_PARAM_RET_BASENAME) - setbasename(cs.back(), params, buf.basename, buflen); + if ((ret = setbasename(cs.back(), params, buf.basename, buflen))) + return ret; if (params.flags & GPI_PARAM_RET_HANDLE) params.handle = new gpi_priv(cs); @@ -158,7 +170,7 @@ cbl_gpi_cur_status(gpi_param_t ¶ms, union retbuf buf, unsigned buflen) } int16_t -cbl_gpi_named_status(gpi_param_t ¶ms, union retbuf buf, unsigned buflen) +cbl_gpi_named_status(gpi_param_t ¶ms, union retbuf buf, unsigned *buflen) { /* TODO: how are we supposed to return for a "named program" * if no name is given?*/ @@ -167,78 +179,86 @@ cbl_gpi_named_status(gpi_param_t ¶ms, union retbuf buf, unsigned buflen) } int16_t -cbl_gpi_parent_status(gpi_param_t ¶ms, union retbuf buf, unsigned buflen) +cbl_gpi_parent_status(gpi_param_t ¶ms, union retbuf buf, unsigned *buflen) { + int16_t ret; gpi_priv *prv = params.handle; - if (prv->it + 1 >= prv->callstack.crend()) - return -1; + if (!prv) + return 1001; + else if (prv->it + 1 >= prv->callstack.crend()) + return 500; else if (params.flags & GPI_PARAM_RET_BASENAME) - setbasename(*++prv->it, params, buf.basename, buflen); + if ((ret = setbasename(*++prv->it, params, buf.basename, buflen))) + return ret; /* TODO: set status bits */ return 0; } int16_t -cbl_gpi_close_handle(gpi_param_t ¶ms, union retbuf buf, unsigned buflen) +cbl_gpi_close_handle(gpi_param_t ¶ms, union retbuf buf, unsigned *buflen) { + if (!params.handle) + return 1001; + delete params.handle; /* TODO: set status bits */ return 0; } int16_t -cbl_gpi_first_ep(gpi_param_t ¶ms, union retbuf buf, unsigned buflen) +cbl_gpi_first_ep(gpi_param_t ¶ms, union retbuf buf, unsigned *buflen) { fprintf(stderr, "%s: TODO\n", __func__); return -1; } int16_t -cbl_gpi_next_ep(gpi_param_t ¶ms, union retbuf buf, unsigned buflen) +cbl_gpi_next_ep(gpi_param_t ¶ms, union retbuf buf, unsigned *buflen) { fprintf(stderr, "%s: TODO\n", __func__); return -1; } int16_t -cbl_gpi_cancel_search_ep(gpi_param_t ¶ms, union retbuf buf, unsigned buflen) +cbl_gpi_cancel_search_ep(gpi_param_t ¶ms, union retbuf buf, + unsigned *buflen) { fprintf(stderr, "%s: TODO\n", __func__); return -1; } int16_t -cbl_gpi_prg_name(gpi_param_t ¶ms, union retbuf buf, unsigned buflen) +cbl_gpi_prg_name(gpi_param_t ¶ms, union retbuf buf, unsigned *buflen) { fprintf(stderr, "%s: TODO\n", __func__); return -1; } int16_t -cbl_gpi_nargs(gpi_param_t ¶ms, union retbuf buf, unsigned buflen) +cbl_gpi_nargs(gpi_param_t ¶ms, union retbuf buf, unsigned *buflen) { fprintf(stderr, "%s: TODO\n", __func__); return -1; } int16_t -cbl_gpi_reserved(gpi_param_t ¶ms, union retbuf buf, unsigned buflen) +cbl_gpi_reserved(gpi_param_t ¶ms, union retbuf buf, unsigned *buflen) { fprintf(stderr, "%s: TODO\n", __func__); return -1; } int16_t -cbl_gpi_path_prg_name(gpi_param_t ¶ms, union retbuf buf, unsigned buflen) +cbl_gpi_path_prg_name(gpi_param_t ¶ms, union retbuf buf, unsigned *buflen) { fprintf(stderr, "%s: TODO\n", __func__); return -1; } typedef int16_t (*gpi_func_t)(gpi_param_t ¶ms, union retbuf buf, - unsigned buflen); + unsigned *buflen); static const struct func { @@ -324,17 +344,9 @@ static int checkflags(uint32_t fn, uint32_t flags) if (flags & mask) { if (!(f.accept & mask) && !(f.ignore & mask)) - { - fprintf(stderr, "bit %" PRIu32 " not allowed for function %" PRIu32 - "\n", i, fn); return -1; - } else if (f.unimplemented & mask) - { - fprintf(stderr, "bit %" PRIu32 " unimplemented for function %" PRIu32 - "\n", i, fn); return -1; - } } } @@ -342,27 +354,14 @@ static int checkflags(uint32_t fn, uint32_t flags) } extern "C" -int16_t cbl_gpi(uint32_t fn, struct gpi_param_t ¶ms, union retbuf buf, +int16_t cbl_gpi(uint32_t fn, struct gpi_param_t *params, union retbuf buf, uint32_t *buflen) { - if (fn >= sizeof funcs / sizeof *funcs) - { - fprintf(stderr, "invalid function number %u\n", fn); - return -1; - } - - if (params.size != sizeof params) - { - fprintf(stderr, "invalid cblte-gpi-size, expected %zu, got %u\n", - sizeof params, params.size); - assert(params.size == sizeof params); - } - - if (checkflags(fn, params.flags)) - { - fprintf(stderr, "invalid bits\n"); - return -1; - } + if (fn >= sizeof funcs / sizeof *funcs + || !params + || params->size != sizeof *params + || checkflags(fn, params->flags)) + return 1009; - return funcs[fn].func(params, buf, *buflen); + return funcs[fn].func(*params, buf, buflen); }
