Fortran] PR92284 – gfc_desc_to_cfi_desc fixes
authorTobias Burnus <burnus@gcc.gnu.org>
Thu, 31 Oct 2019 10:12:55 +0000 (11:12 +0100)
committerTobias Burnus <burnus@gcc.gnu.org>
Thu, 31 Oct 2019 10:12:55 +0000 (11:12 +0100)
        gcc/fortran/
        PR fortran/92284.
        * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Free CFI descriptor
        at the end; partial revised revert of Rev. 277502.

        libgfortran/
        PR fortran/92284.
        * runtime/ISO_Fortran_binding.c (gfc_desc_to_cfi_desc):

        gcc/testsuite/
        PR fortran/92284.
        * gfortran.dg/bind-c-intent-out.f90: Update expected dump;
        extend comment.
        * gfortran.dg/bind_c_array_params_3.f90: New.
        * gfortran.dg/bind_c_array_params_3_aux.c: New.

From-SVN: r277663

gcc/fortran/ChangeLog
gcc/fortran/trans-expr.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/bind-c-intent-out.f90
gcc/testsuite/gfortran.dg/bind_c_array_params_3.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/bind_c_array_params_3_aux.c [new file with mode: 0644]
libgfortran/ChangeLog
libgfortran/runtime/ISO_Fortran_binding.c

index e1771687d16530f4e934368753a0ce0799caf4a6..6cd05d130b122c6613e48ad1e0a42888709f138e 100644 (file)
@@ -1,3 +1,9 @@
+2019-10-31  Tobias Burnus  <tobias@codesourcery.com>
+
+       PR fortran/92284.
+       * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Free CFI descriptor
+       at the end; partial revised revert of Rev. 277502.
+
 2019-10-31  Tobias Burnus  <tobias@codesourcery.com>
 
        PR fortran/92277
index 381e314a9b56dae5ae86a07121dcab7e703da01c..f800faaa4e537c340c9b18e64b2d5c0d3d4a4b48 100644 (file)
@@ -5306,13 +5306,13 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
   /* Now pass the gfc_descriptor by reference.  */
   parmse->expr = gfc_build_addr_expr (NULL_TREE, parmse->expr);
 
-  /* Variables to point to the gfc and CFI descriptors.  */
+  /* Variables to point to the gfc and CFI descriptors; cfi = NULL implies
+     that the CFI descriptor is allocated by the gfor_fndecl_gfc_to_cfi call.  */
   gfc_desc_ptr = parmse->expr;
   cfi_desc_ptr = gfc_create_var (pvoid_type_node, "cfi");
-  gfc_add_modify (&parmse->pre, cfi_desc_ptr,
-                 build_int_cst (pvoid_type_node, 0));
+  gfc_add_modify (&parmse->pre, cfi_desc_ptr, null_pointer_node);
 
-  /* Allocate the CFI descriptor and fill the fields.  */
+  /* Allocate the CFI descriptor itself and fill the fields.  */
   tmp = gfc_build_addr_expr (NULL_TREE, cfi_desc_ptr);
   tmp = build_call_expr_loc (input_location,
                             gfor_fndecl_gfc_to_cfi, 2, tmp, gfc_desc_ptr);
@@ -5327,6 +5327,10 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
   /* The CFI descriptor is passed to the bind_C procedure.  */
   parmse->expr = cfi_desc_ptr;
 
+  /* Free the CFI descriptor.  */
+  tmp = gfc_call_free (cfi_desc_ptr);
+  gfc_prepend_expr_to_block (&parmse->post, tmp);
+
   /* Transfer values back to gfc descriptor.  */
   tmp = gfc_build_addr_expr (NULL_TREE, parmse->expr);
   tmp = build_call_expr_loc (input_location,
index 8e6588a8b0248151a50e0a5665d36ccba0c4bb07..1cbb91283857f630caddf74fbc87dda8db65f22f 100644 (file)
@@ -1,3 +1,11 @@
+2019-10-31  Tobias Burnus  <tobias@codesourcery.com>
+
+       PR fortran/92284.
+       * gfortran.dg/bind-c-intent-out.f90: Update expected dump;
+       extend comment.
+       * gfortran.dg/bind_c_array_params_3.f90: New.
+       * gfortran.dg/bind_c_array_params_3_aux.c: New.
+
 2019-10-31  Jakub Jelinek  <jakub@redhat.com>
 
        * c-c++-common/gomp/declare-variant-9.c: New test.
index 493e546d45df9372bdb0fb45a9bf20fc6e1516b8..39822c0753a77d0527394a53b152d2f80701ddcc 100644 (file)
@@ -35,7 +35,8 @@ end program p
 ! the intent(out) implies freeing in the callee (!), hence the "free"
 ! It is the only 'free' as 'a' is part of the main program and, hence, implicitly has the SAVE attribute.
 ! The  'cfi = 0' appears before the call due to the deallocate and when preparing the C descriptor
+! As cfi (i.e. the descriptor itself) is allocated in libgomp, it has to be freed after the call.
 
-! { dg-final { scan-tree-dump-times "__builtin_free" 1 "original" } }
-! { dg-final { scan-tree-dump-times "__builtin_free \\(cfi\\.\[0-9\]+\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_free" 2 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_free \\(cfi\\.\[0-9\]+\\);" 2 "original" } }
 ! { dg-final { scan-tree-dump-times "cfi\\.\[0-9\]+ = 0B;" 2 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/bind_c_array_params_3.f90 b/gcc/testsuite/gfortran.dg/bind_c_array_params_3.f90
new file mode 100644 (file)
index 0000000..d5bad7d
--- /dev/null
@@ -0,0 +1,39 @@
+! { dg-do run }
+! { dg-additional-sources bind_c_array_params_3_aux.c }
+!
+! PR fortran/92284
+!
+! Contributed by José Rui Faustino de Sousa
+!
+program arr_p
+  use, intrinsic :: iso_c_binding, only: c_int
+  implicit none (type, external)
+
+  integer(kind=c_int), pointer :: arr(:)
+  integer :: i
+
+  nullify(arr)
+  call arr_set(arr)
+
+  if (.not.associated(arr)) stop 1
+  if (lbound(arr,dim=1) /= 1) stop 2
+  if (ubound(arr,dim=1) /= 9) stop 3
+  if (any (arr /= [(i, i=0,8)])) stop 4
+  deallocate(arr)
+
+contains
+
+  subroutine arr_set(this) !bind(c)
+    integer(kind=c_int), pointer, intent(out) :: this(:)
+
+    interface
+      subroutine arr_set_c(this) bind(c)
+        use, intrinsic :: iso_c_binding, only: c_int
+        implicit none
+        integer(kind=c_int), pointer, intent(out) :: this(:)
+      end subroutine arr_set_c
+    end interface
+
+    call arr_set_c(this)
+  end subroutine arr_set
+end program arr_p
diff --git a/gcc/testsuite/gfortran.dg/bind_c_array_params_3_aux.c b/gcc/testsuite/gfortran.dg/bind_c_array_params_3_aux.c
new file mode 100644 (file)
index 0000000..6e13aa3
--- /dev/null
@@ -0,0 +1,27 @@
+/* Used by bind_c_array_params_3.f90.  */
+/* PR fortran/92284.  */
+
+#include <assert.h>
+#include <errno.h>
+#include <stdio.h>
+
+#include "ISO_Fortran_binding.h"
+
+void arr_set_c(CFI_cdesc_t*);
+
+void arr_set_c(CFI_cdesc_t *arr){
+  int i, stat, *auxp = NULL;
+  CFI_index_t   lb[] = {1};
+  CFI_index_t   ub[] = {9};
+  
+  assert(arr);
+  assert(arr->rank==1);
+  assert(!arr->base_addr);
+  stat = CFI_allocate(arr, lb, ub, sizeof(int));
+  assert(stat==CFI_SUCCESS);
+  auxp = (int*)arr->base_addr;
+  assert(auxp);
+  for(i=0; i<ub[0]-lb[0]+1; i++) auxp[i]=i;
+  return;
+}
+
index 642134883db55c5960522a49bf5939a02cb25e14..c2031cfdafdf2d0fe4c99255fd6f3d8a1eb8ce84 100644 (file)
@@ -1,3 +1,8 @@
+2019-10-31  Tobias Burnus  <tobias@codesourcery.com>
+
+       PR fortran/92284.
+       * runtime/ISO_Fortran_binding.c (gfc_desc_to_cfi_desc):
+
 2019-10-19  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/91926
@@ -7,8 +12,7 @@
 2019-10-08  Thomas Schwinge  <thomas@codesourcery.com>
 
        PR fortran/68401
-        * runtime/minimal.c (os_error_at): New function.
-
+       * runtime/minimal.c (os_error_at): New function.
        * runtime/minimal.c: Revise.
 
 2019-10-05  Paul Thomas  <pault@gcc.gnu.org>
index 695ef57ac32977455ff2980c5cbe139b14d64f45..c71d8e894539a60deb8279f2a6606f9c38c98ea0 100644 (file)
@@ -119,24 +119,25 @@ gfc_desc_to_cfi_desc (CFI_cdesc_t **d_ptr, const gfc_array_void *s)
     d->type = (CFI_type_t)(d->type
                + ((CFI_type_t)d->elem_len << CFI_type_kind_shift));
 
-  /* Full pointer or allocatable arrays retain their lower_bounds.  */
-  for (n = 0; n < GFC_DESCRIPTOR_RANK (s); n++)
-    {
-      if (d->attribute != CFI_attribute_other)
-       d->dim[n].lower_bound = (CFI_index_t)GFC_DESCRIPTOR_LBOUND(s, n);
-      else
-       d->dim[n].lower_bound = 0;
-
-      /* Assumed size arrays have gfc ubound == 0 and CFI extent = -1.  */
-      if ((n == GFC_DESCRIPTOR_RANK (s) - 1)
-         && GFC_DESCRIPTOR_LBOUND(s, n) == 1
-         && GFC_DESCRIPTOR_UBOUND(s, n) == 0)
-       d->dim[n].extent = -1;
-      else
-       d->dim[n].extent = (CFI_index_t)GFC_DESCRIPTOR_UBOUND(s, n)
-                           - (CFI_index_t)GFC_DESCRIPTOR_LBOUND(s, n) + 1;
-      d->dim[n].sm = (CFI_index_t)(GFC_DESCRIPTOR_STRIDE(s, n) * s->span);
-    }
+  if (d->base_addr)
+    /* Full pointer or allocatable arrays retain their lower_bounds.  */
+    for (n = 0; n < GFC_DESCRIPTOR_RANK (s); n++)
+      {
+       if (d->attribute != CFI_attribute_other)
+         d->dim[n].lower_bound = (CFI_index_t)GFC_DESCRIPTOR_LBOUND(s, n);
+       else
+         d->dim[n].lower_bound = 0;
+
+       /* Assumed size arrays have gfc ubound == 0 and CFI extent = -1.  */
+       if (n == GFC_DESCRIPTOR_RANK (s) - 1
+           && GFC_DESCRIPTOR_LBOUND(s, n) == 1
+           && GFC_DESCRIPTOR_UBOUND(s, n) == 0)
+         d->dim[n].extent = -1;
+       else
+         d->dim[n].extent = (CFI_index_t)GFC_DESCRIPTOR_UBOUND(s, n)
+                            - (CFI_index_t)GFC_DESCRIPTOR_LBOUND(s, n) + 1;
+       d->dim[n].sm = (CFI_index_t)(GFC_DESCRIPTOR_STRIDE(s, n) * s->span);
+      }
 
   if (*d_ptr == NULL)
     *d_ptr = d;