[PATCH, Fortran] [PR libfortran/101310] Bind(c): Fix bugs in CFI_section

[PATCH, Fortran] [PR libfortran/101310] Bind(c): Fix bugs in CFI_section

[Sandra Loosemore]

[-- Attachment #1: Type: text/plain, Size: 1591 bytes --]

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

[-- Attachment #2: pr101310.patch --]
[-- Type: text/x-patch, Size: 13186 bytes --]

commit a2e189aeb165781fe741f942e00bf073a496af92
Author: Sandra Loosemore <sandra@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  <sandra@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 *)&section, 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*)&section, 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 *)&section, 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*)&section, 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;
 }
 

Re: [PATCH, Fortran] [PR libfortran/101310] Bind(c): Fix bugs in CFI_section

[Tobias Burnus]

On 18.07.21 06:36, Sandra Loosemore wrote:
> 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.

Namely:  for CFI_section(result, source, /*lower_bound */ {5, 7}, ...),
the result was: 5 and 6 for i=1,2 in result->dim[i].lower_bound.

With the attached patch, it is == 0. The latter is closer to the
generic Fortran behavior, where in Fortran:  lbound(A(5:,7:)) == [1,1].
And CFI arrays passed to nonallocatable, nonpointer dummies have [0,0] as
lower bound.

> 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.

I think something has to set a lower bound. For
   CFI_establish (dv, /* base_addr = */ NULL, ...)
it is not mandated to set dv->dim[i].lower_bound (as base_addr=NULL).

On the other hand, CFI_section(...) also does not explicitly require it
to be set.

Hence, lower_bound can be unset – but that does not work well, especially
not when the uninitialized lower_bound either exceeds 'int' or even
'ptrdiff_t'.

This issue shows up when not setting lower_bound in CFI_section, e.g.
at
   ts29113/interoperability/cf-descriptor-6-c.c's ctest()
(submitted v2 testsuite, not yet committed),
which uses 'int' and overflows.

And for
   gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.c
which assumed in the CFI_address call that lower_bound == 0.

  * * *

Thus: I think we really should set it in CFI_section – and the choice
to set it to 0 is in my opinion better than to set it to lower_bound.

I wonder whether we need to add a comment before
    result->dim[o].lower_bound = 0;
Maybe:
   /* If result was established with base_addr = NULL, its lower bound it
      unset; while Fortran 2018 does not specify that CFI_section updates
      the lower_bound, setting it to zero is sensible and in line with
      Fortran subsections having a lower bound of 1.  */

> The bug in the older ISO_Fortran_binding_1.c testcase was an incorrect
> assertion about the lower bound behavior,
Concur.
> 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.

I tried it with the 'dim[i].lower_bound = 0;' line commented out;
in any case, I see the following XPASS with the such-modified patch
applied:
gfortran.dg/ts29113/library/section-1p.f90
gfortran.dg/ts29113/library/section-2p.f90
gfortran.dg/ts29113/library/section-3p.f90
gfortran.dg/ts29113/interoperability/cf-descriptor-2.f90
gfortran.dg/ts29113/interoperability/fc-out-descriptor-7.f90

>      [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<sandra@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.

LGTM – thanks for the patch!

Tobias

-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955