Fortran] PR92284 – gfc_desc_to_cfi_desc fixes
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
This commit is contained in:
parent
9ba66bf5b9
commit
fc5a970817
|
@ -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
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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" } }
|
||||
|
|
|
@ -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
|
|
@ -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;
|
||||
}
|
||||
|
|
@ -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>
|
||||
|
|
|
@ -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;
|
||||
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);
|
||||
}
|
||||
/* 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;
|
||||
|
|
Loading…
Reference in New Issue