From: Sandra Loosemore Date: Sat, 17 Jul 2021 23:12:18 +0000 (-0700) Subject: Bind(c): Fix bugs in CFI_section X-Git-Tag: basepoints/gcc-13~5759 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=b4a9bc7856ee1d3ff98b04402334a362540af2cf;p=thirdparty%2Fgcc.git Bind(c): Fix bugs in CFI_section CFI_section was incorrectly adjusting the base pointer for the result array twice in different ways. It was also overwriting the array dimension info in the result descriptor before computing the base address offset from the source descriptor, which caused problems if the two descriptors are the same. This patch fixes both problems and makes the code simpler, too. A consequence of this patch is that the result array is now 0-based in all dimensions instead of starting at the numbering to match the first element of the source array. The Fortran standard only specifies the shape of the result array, not its lower bounds, so this is permitted and probably less confusing for users as well as implementors. 2021-07-17 Sandra Loosemore PR libfortran/101310 libgfortran/ * runtime/ISO_Fortran_binding.c (CFI_section): Fix the base address computation and simplify the code. gcc/testsuite/ * gfortran.dg/ISO_Fortran_binding_1.c (section_c): Remove incorrect assertions. --- diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.c b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.c index 9da5d8588061..bb56ca0e04bc 100644 --- a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.c +++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.c @@ -142,11 +142,12 @@ float section_c(int *std_case, CFI_cdesc_t * source, int *low, int *str) CFI_type_float, 0, 1, NULL); if (ind) return -1.0; ind = CFI_section((CFI_cdesc_t *)§ion, source, lower, NULL, strides); - assert (section.dim[0].lower_bound == lower[0]); if (ind) return -2.0; /* Sum over the section */ - for (idx[0] = lower[0]; idx[0] < section.dim[0].extent + lower[0]; idx[0]++) + for (idx[0] = section.dim[0].lower_bound; + idx[0] < section.dim[0].extent + section.dim[0].lower_bound; + idx[0]++) ans += *(float*)CFI_address ((CFI_cdesc_t*)§ion, idx); return ans; } @@ -164,11 +165,12 @@ float section_c(int *std_case, CFI_cdesc_t * source, int *low, int *str) ind = CFI_section((CFI_cdesc_t *)§ion, source, lower, upper, strides); assert (section.rank == 1); - assert (section.dim[0].lower_bound == lower[0]); if (ind) return -2.0; /* Sum over the section */ - for (idx[0] = lower[0]; idx[0] < section.dim[0].extent + lower[0]; idx[0]++) + for (idx[0] = section.dim[0].lower_bound; + idx[0] < section.dim[0].extent + section.dim[0].lower_bound; + idx[0]++) ans += *(float*)CFI_address ((CFI_cdesc_t*)§ion, idx); return ans; } diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c index b1e51612e2b2..2830c4575fea 100644 --- a/libgfortran/runtime/ISO_Fortran_binding.c +++ b/libgfortran/runtime/ISO_Fortran_binding.c @@ -689,29 +689,22 @@ int CFI_section (CFI_cdesc_t *result, const CFI_cdesc_t *source, } } + /* Set the base address. We have to compute this first in the case + where source == result, before we overwrite the dimension data. */ + result->base_addr = CFI_address (source, lower); + /* Set the appropriate dimension information that gives us access to the * data. */ - int aux = 0; - for (int i = 0; i < source->rank; i++) + for (int i = 0, o = 0; i < source->rank; i++) { if (stride[i] == 0) - { - aux++; - /* Adjust 'lower' for the base address offset. */ - lower[i] = lower[i] - source->dim[i].lower_bound; - continue; - } - int idx = i - aux; - result->dim[idx].lower_bound = lower[i]; - result->dim[idx].extent = 1 + (upper[i] - lower[i])/stride[i]; - result->dim[idx].sm = stride[i] * source->dim[i].sm; - /* Adjust 'lower' for the base address offset. */ - lower[idx] = lower[idx] - source->dim[i].lower_bound; + continue; + result->dim[o].lower_bound = 0; + result->dim[o].extent = 1 + (upper[i] - lower[i])/stride[i]; + result->dim[o].sm = stride[i] * source->dim[i].sm; + o++; } - /* Set the base address. */ - result->base_addr = CFI_address (source, lower); - return CFI_SUCCESS; }