[gcc/devel/omp/gcc-9] Backport Fortran BIND(C) fixes
Tobias Burnus
burnus@gcc.gnu.org
Thu Mar 5 14:20:00 GMT 2020
https://gcc.gnu.org/g:525c4e8d3ae4e49657d1253f448fb9f2293558f8
commit 525c4e8d3ae4e49657d1253f448fb9f2293558f8
Author: Tobias Burnus <tobias@codesourcery.com>
Date: Mon Nov 4 14:14:43 2019 +0000
Backport Fortran BIND(C) fixes
gcc/fortran/
Backport from mainline
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.
gcc/testsuite/
Backport from mainline
2019-10-31 Jakub Jelinek <jakub@redhat.com>
PR fortran/92284
* gfortran.dg/bind_c_array_params_3_aux.c: Include
../../../libgfortran/ISO_Fortran_binding.h rather than
ISO_Fortran_binding.h.
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 Tobias Burnus <tobias@codesourcery.com>
PR fortran/92277
* fortran.dg/pr92277.f90: New.
From-SVN: r277781
Diff:
---
gcc/fortran/ChangeLog | 9 +++++
gcc/fortran/trans-expr.c | 12 ++++---
gcc/testsuite/ChangeLog | 24 +++++++++++++
gcc/testsuite/gfortran.dg/bind-c-intent-out.f90 | 5 +--
.../gfortran.dg/bind_c_array_params_3.f90 | 39 ++++++++++++++++++++++
.../gfortran.dg/bind_c_array_params_3_aux.c | 26 +++++++++++++++
gcc/testsuite/gfortran.dg/pr92277.f90 | 32 ++++++++++++++++++
libgfortran/runtime/ISO_Fortran_binding.c | 37 ++++++++++----------
8 files changed, 160 insertions(+), 24 deletions(-)
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 759390f..c4c16d9 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2019-11-04 Tobias Burnus <tobias@codesourcery.com>
+
+ Backport from mainline
+ 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-28  Paul Thomas  <pault@gcc.gnu.org>
Backport from trunk
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 71f2988..245e656 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5090,13 +5090,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);
@@ -5111,6 +5111,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,
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index b21af8b..4cf0555 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,27 @@
+2019-11-04 Tobias Burnus <tobias@codesourcery.com>
+
+ Backport from mainline
+ 2019-10-31 Jakub Jelinek <jakub@redhat.com>
+
+ PR fortran/92284
+ * gfortran.dg/bind_c_array_params_3_aux.c: Include
+ ../../../libgfortran/ISO_Fortran_binding.h rather than
+ ISO_Fortran_binding.h.
+
+ 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 Tobias Burnus <tobias@codesourcery.com>
+
+ PR fortran/92277
+ * fortran.dg/pr92277.f90: New.
+
+
2019-10-30 Iain Sandoe <iain@sandoe.co.uk>
Backport from mainline.
diff --git a/gcc/testsuite/gfortran.dg/bind-c-intent-out.f90 b/gcc/testsuite/gfortran.dg/bind-c-intent-out.f90
index 493e546..39822c0 100644
--- a/gcc/testsuite/gfortran.dg/bind-c-intent-out.f90
+++ b/gcc/testsuite/gfortran.dg/bind-c-intent-out.f90
@@ -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
index 0000000..d5bad7d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_array_params_3.f90
@@ -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
index 0000000..07d1a03
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_array_params_3_aux.c
@@ -0,0 +1,26 @@
+/* Used by bind_c_array_params_3.f90. */
+/* PR fortran/92284. */
+
+#include <assert.h>
+#include <errno.h>
+#include <stdio.h>
+
+#include "../../../libgfortran/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;
+}
diff --git a/gcc/testsuite/gfortran.dg/pr92277.f90 b/gcc/testsuite/gfortran.dg/pr92277.f90
new file mode 100644
index 0000000..5121063
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr92277.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+!
+! PR fortran/92277
+!
+! Contributed by José Rui Faustino de Sousa
+!
+module arr_m
+ implicit none
+contains
+ subroutine arr_set(this, that)
+ integer, intent(out) :: this(..)
+ integer, optional, intent(out) :: that(..)
+
+ interface
+ subroutine arr_set_c(this) bind(c)
+ use, intrinsic :: iso_c_binding, only: c_int
+ implicit none
+ integer(kind=c_int), intent(out) :: this(..)
+ end subroutine arr_set_c
+ subroutine arr_set_c_opt(this) bind(c)
+ use, intrinsic :: iso_c_binding, only: c_int
+ implicit none
+ integer(kind=c_int), optional, intent(out) :: this(..)
+ end subroutine arr_set_c_opt
+ end interface
+
+ call arr_set_c(this)
+ call arr_set_c(that)
+ call arr_set_c_opt(this)
+ call arr_set_c_opt(that)
+ end subroutine arr_set
+end module arr_m
diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c
index 695ef57..c71d8e8 100644
--- a/libgfortran/runtime/ISO_Fortran_binding.c
+++ b/libgfortran/runtime/ISO_Fortran_binding.c
@@ -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;
More information about the Gcc-cvs
mailing list