This patch fixes bugs I observed in tests for the CFI_section function
-- it turns out both the function and test cases had bugs. :-(
The bugs in CFI_section itself had to do with incorrect computation of
the base address for the result descriptor, plus an ordering problem
that caused it not to work if the source and result descriptors are the
same. I fixed this by rewriting the loop to fill in the dimension info
for the result array and reordering it with respect to the base address
computation.
Note that the old version of CFI_section attempted to preserve the lower
bounds of the section passed in as an argument. This is not actually
required by the Fortran standard, which specifies only the shape of the
result array, not its bounds. My rewritten version produces an array
with zero lower bounds, similar to what CFI_establish produces given the
shape as input. If this change is seen as undesirable, of course it can
be changed back to correctly do what it was previously unsuccessfully
trying to do. :-P
The bug in the older ISO_Fortran_binding_1.c testcase was an incorrect
assertion about the lower bound behavior, while the bugs in the
not-yet-committed TS29113 testsuite were due to me having previously
lost track of having fixed this already and just failing to save the fix
before I posted the testsuite patch. As with the other patches I've
been posting for TS29113 testsuite issues, I can refactor the testsuite
changes to lump them all in with the base testsuite patch depending on
the order that things get reviewed/committed.
-Sandra
commit a2e189aeb165781fe741f942e00bf073a496af92
Author: Sandra Loosemore <san...@codesourcery.com>
Date: Sat Jul 17 16:12:18 2021 -0700
[PR libfortran/101310] 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 <san...@codesourcery.com>
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.
* gfortran.dg/ts29113/library/section-3.f90: Fix indexing bugs.
* gfortran.dg/ts29113/library/section-3p.f90: Likewise.
* gfortran.dg/ts29113/library/section-4-c.c: New file.
* gfortran.dg/ts29113/library/section-4.f90: New file.
diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.c b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.c
index 9da5d85..bb56ca0 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/gcc/testsuite/gfortran.dg/ts29113/library/section-3.f90 b/gcc/testsuite/gfortran.dg/ts29113/library/section-3.f90
index 6811891..e51c084 100644
--- a/gcc/testsuite/gfortran.dg/ts29113/library/section-3.f90
+++ b/gcc/testsuite/gfortran.dg/ts29113/library/section-3.f90
@@ -40,12 +40,12 @@ program testit
end do
end do
- call test (aa, 3, 1, 3, 20, 1, 1) ! full slice 0
- call test (aa, 1, 8, 10, 8, 1, 1) ! full slice 1
- call test (aa, 3, 5, 3, 14, 1, 3) ! partial slice 0
- call test (aa, 2, 8, 10, 8, 2, 1) ! partial slice 1
- call test (aa, 3, 14, 3, 5, 1, -3) ! backwards slice 0
- call test (aa, 10, 8, 2, 8, -2, 1) ! backwards slice 1
+ call test (aa, 3, 1, 3, 20, 0, 1) ! full slice 0
+ call test (aa, 1, 8, 10, 8, 1, 0) ! full slice 1
+ call test (aa, 3, 5, 3, 14, 0, 3) ! partial slice 0
+ call test (aa, 2, 8, 10, 8, 2, 0) ! partial slice 1
+ call test (aa, 3, 14, 3, 5, 0, -3) ! backwards slice 0
+ call test (aa, 10, 8, 2, 8, -2, 0) ! backwards slice 1
contains
diff --git a/gcc/testsuite/gfortran.dg/ts29113/library/section-3p.f90 b/gcc/testsuite/gfortran.dg/ts29113/library/section-3p.f90
index a6a9c7d..a44e1c8 100644
--- a/gcc/testsuite/gfortran.dg/ts29113/library/section-3p.f90
+++ b/gcc/testsuite/gfortran.dg/ts29113/library/section-3p.f90
@@ -41,28 +41,28 @@ program testit
end do
! Zero lower bound
- call test (aa, 0, 0, 2, 0, 2, 19, 1, 1) ! full slice 0
- call test (aa, 0, 0, 0, 7, 9, 7, 1, 1) ! full slice 1
- call test (aa, 0, 0, 2, 4, 2, 13, 1, 3) ! partial slice 0
- call test (aa, 0, 0, 1, 7, 9, 7, 2, 1) ! partial slice 1
- call test (aa, 0, 0, 2, 13, 2, 4, 1, -3) ! backwards slice 0
- call test (aa, 0, 0, 9, 7, 1, 7, -2, 1) ! backwards slice 1
+ call test (aa, 0, 0, 2, 0, 2, 19, 0, 1) ! full slice 0
+ call test (aa, 0, 0, 0, 7, 9, 7, 1, 0) ! full slice 1
+ call test (aa, 0, 0, 2, 4, 2, 13, 0, 3) ! partial slice 0
+ call test (aa, 0, 0, 1, 7, 9, 7, 2, 0) ! partial slice 1
+ call test (aa, 0, 0, 2, 13, 2, 4, 0, -3) ! backwards slice 0
+ call test (aa, 0, 0, 9, 7, 1, 7, -2, 0) ! backwards slice 1
! Lower bound 1
- call test (aa, 1, 1, 3, 1, 3, 20, 1, 1) ! full slice 0
- call test (aa, 1, 1, 1, 8, 10, 8, 1, 1) ! full slice 1
- call test (aa, 1, 1, 3, 5, 3, 14, 1, 3) ! partial slice 0
- call test (aa, 1, 1, 2, 8, 10, 8, 2, 1) ! partial slice 1
- call test (aa, 1, 1, 3, 14, 3, 5, 1, -3) ! backwards slice 0
- call test (aa, 1, 1, 10, 8, 2, 8, -2, 1) ! backwards slice 1
+ call test (aa, 1, 1, 3, 1, 3, 20, 0, 1) ! full slice 0
+ call test (aa, 1, 1, 1, 8, 10, 8, 1, 0) ! full slice 1
+ call test (aa, 1, 1, 3, 5, 3, 14, 0, 3) ! partial slice 0
+ call test (aa, 1, 1, 2, 8, 10, 8, 2, 0) ! partial slice 1
+ call test (aa, 1, 1, 3, 14, 3, 5, 0, -3) ! backwards slice 0
+ call test (aa, 1, 1, 10, 8, 2, 8, -2, 0) ! backwards slice 1
! Some other lower bound
- call test (aa, 2, 3, 4, 3, 4, 22, 1, 1) ! full slice 0
- call test (aa, 2, 3, 2, 10, 11, 10, 1, 1) ! full slice 1
- call test (aa, 2, 3, 4, 7, 4, 16, 1, 3) ! partial slice 0
- call test (aa, 2, 3, 1, 10, 11, 10, 2, 1) ! partial slice 1
- call test (aa, 2, 3, 4, 16, 4, 7, 1, -3) ! backwards slice 0
- call test (aa, 2, 3, 11, 10, 3, 10, -2, 1) ! backwards slice 1
+ call test (aa, 2, 3, 4, 3, 4, 22, 0, 1) ! full slice 0
+ call test (aa, 2, 3, 2, 10, 11, 10, 1, 0) ! full slice 1
+ call test (aa, 2, 3, 4, 7, 4, 16, 0, 3) ! partial slice 0
+ call test (aa, 2, 3, 3, 10, 11, 10, 2, 0) ! partial slice 1
+ call test (aa, 2, 3, 4, 16, 4, 7, 0, -3) ! backwards slice 0
+ call test (aa, 2, 3, 11, 10, 3, 10, -2, 0) ! backwards slice 1
contains
@@ -108,16 +108,16 @@ contains
if (ubound (rr, 1) .ne. (ub1 - lb1)/s1 + 1) stop 113
o1 = 1
do i1 = lb1, ub1, s1
- if (rr(o1)%x .ne. lb0) stop 114
- if (rr(o1)%y .ne. i1) stop 114
+ if (rr(o1)%x .ne. lb0 - lo0 + 1) stop 114
+ if (rr(o1)%y .ne. i1 - lo1 + 1) stop 114
o1 = o1 + 1
end do
else
if (ubound (rr, 1) .ne. (ub0 - lb0)/s0 + 1) stop 113
o0 = 1
do i0 = lb0, ub0, s0
- if (rr(o0)%x .ne. i0) stop 114
- if (rr(o0)%y .ne. lb1) stop 114
+ if (rr(o0)%x .ne. i0 - lo0 + 1) stop 114
+ if (rr(o0)%y .ne. lb1 - lo1 + 1) stop 114
o0 = o0 + 1
end do
end if
diff --git a/gcc/testsuite/gfortran.dg/ts29113/library/section-4-c.c b/gcc/testsuite/gfortran.dg/ts29113/library/section-4-c.c
new file mode 100644
index 0000000..7725443
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ts29113/library/section-4-c.c
@@ -0,0 +1,101 @@
+#include <stdlib.h>
+#include <stdio.h>
+
+#include "ISO_Fortran_binding.h"
+#include "../dump-descriptors.h"
+
+struct m {
+ int i, j, k, l;
+};
+
+extern void ctest (void);
+
+#define IMAX 6
+#define JMAX 8
+#define KMAX 10
+#define LMAX 12
+
+static struct m buffer[LMAX][KMAX][JMAX][IMAX];
+
+static void
+check_element (struct m *mp, int i, int j, int k, int l)
+{
+#if 0
+ fprintf (stderr, "expected (%d, %d, %d, %d), got (%d, %d, %d, %d)\n",
+ i, j, k, l, mp->i, mp->j, mp->k, mp->l);
+#endif
+ if (mp->i != i || mp->j != j || mp->k != k || mp->l != l)
+ abort ();
+}
+
+void
+ctest (void)
+{
+ CFI_CDESC_T(4) sdesc;
+ CFI_cdesc_t *source = (CFI_cdesc_t *) &sdesc;
+ CFI_CDESC_T(4) rdesc;
+ CFI_cdesc_t *result = (CFI_cdesc_t *) &rdesc;
+ CFI_index_t extents[4] = { IMAX, JMAX, KMAX, LMAX };
+ CFI_index_t lb[4], ub[4], s[4];
+ int i, j, k, l;
+ int ii, jj, kk, ll;
+
+ /* Initialize the buffer to uniquely label each element. */
+ for (i = 0; i < IMAX; i++)
+ for (j = 0; j < JMAX; j++)
+ for (k = 0; k < KMAX; k++)
+ for (l = 0; l < LMAX; l++)
+ {
+ buffer[l][k][j][i].i = i;
+ buffer[l][k][j][i].j = j;
+ buffer[l][k][j][i].k = k;
+ buffer[l][k][j][i].l = l;
+ }
+
+ /* Establish the source array. */
+ check_CFI_status ("CFI_establish",
+ CFI_establish (source, (void *)buffer,
+ CFI_attribute_pointer, CFI_type_struct,
+ sizeof (struct m), 4, extents));
+
+ /* Try taking a degenerate section (single element). */
+ check_CFI_status ("CFI_establish",
+ CFI_establish (result, NULL,
+ CFI_attribute_pointer, CFI_type_struct,
+ sizeof (struct m), 0, NULL));
+ lb[0] = 3; lb[1] = 4; lb[2] = 5; lb[3] = 6;
+ ub[0] = 3; ub[1] = 4; ub[2] = 5; ub[3] = 6;
+ s[0] = 0; s[1] = 0; s[2] = 0; s[3] = 0;
+ check_CFI_status ("CFI_section",
+ CFI_section (result, source, lb, ub, s));
+ dump_CFI_cdesc_t (result);
+ check_element ((struct m *)result->base_addr, 3, 4, 5, 6);
+
+ /* Try taking a 2d chunk out of the 4d array. */
+ check_CFI_status ("CFI_establish",
+ CFI_establish (result, NULL,
+ CFI_attribute_pointer, CFI_type_struct,
+ sizeof (struct m), 2, NULL));
+ lb[0] = 1; lb[1] = 2; lb[2] = 3; lb[3] = 4;
+ ub[0] = 1; ub[1] = JMAX - 2; ub[2] = 3; ub[3] = LMAX - 2;
+ s[0] = 0; s[1] = 2; s[2] = 0; s[3] = 3;
+ check_CFI_status ("CFI_section",
+ CFI_section (result, source, lb, ub, s));
+ dump_CFI_cdesc_t (result);
+
+ i = lb[0];
+ k = lb[2];
+ for (j = lb[1], jj = result->dim[0].lower_bound;
+ j <= ub[1];
+ j += s[1], jj++)
+ for (l = lb[3], ll = result->dim[1].lower_bound;
+ l <= ub[3];
+ l += s[3], ll++)
+ {
+ CFI_index_t subscripts[2];
+ subscripts[0] = jj;
+ subscripts[1] = ll;
+ check_element ((struct m *) CFI_address (result, subscripts),
+ i, j, k, l);
+ }
+}
diff --git a/gcc/testsuite/gfortran.dg/ts29113/library/section-4.f90 b/gcc/testsuite/gfortran.dg/ts29113/library/section-4.f90
new file mode 100644
index 0000000..ee4b01a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ts29113/library/section-4.f90
@@ -0,0 +1,23 @@
+! PR 101310
+! { dg-do run }
+! { dg-additional-sources "section-4-c.c ../dump-descriptors.c" }
+! { dg-additional-options "-g" }
+!
+! This program tests various scenarios with using CFI_section to extract
+! a section with rank less than the source array. Everything interesting
+! happens on the C side.
+
+program testit
+ use iso_c_binding
+ implicit none
+
+ interface
+ subroutine ctest () bind (c)
+ use iso_c_binding
+ end subroutine
+
+ end interface
+
+ call ctest ()
+
+end program
diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c
index 38e1b6e..9326195 100644
--- a/libgfortran/runtime/ISO_Fortran_binding.c
+++ b/libgfortran/runtime/ISO_Fortran_binding.c
@@ -685,29 +685,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;
}
