procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fortran] PR91863 - fix call to bind(C) with array descriptor

Browse source 
PR fortran/91863
        * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Don't free data
        memory as that's done on the Fortran side.
        (gfc_conv_procedure_call): Handle void* pointers from
        gfc_conv_gfc_desc_to_cfi_desc.

        PR fortran/91863
        * gfortran.dg/bind-c-intent-out.f90: New.

From-SVN: r277502
This commit is contained in:
Tobias Burnus 2019-10-28 07:33:29 +00:00 • committed by Tobias Burnus
parent 6d099a76a0
commit 1c02794484
4 changed files with 62 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View file

@ -1,3 +1,11 @@
2019-10-28 Tobias Burnus <tobias@codesourcery.com>
PR fortran/91863
* trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Don't free data
memory as that's done on the Fortran side.
(gfc_conv_procedure_call): Handle void* pointers from
gfc_conv_gfc_desc_to_cfi_desc.
2019-10-27 Paul Thomas <pault@gcc.gnu.org>
PR fortran/86248

23
gcc/fortran/trans-expr.c
View file

@ -5206,7 +5206,6 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
int attribute;
int cfi_attribute;
symbol_attribute attr = gfc_expr_attr (e);
stmtblock_t block;
/* If this is a full array or a scalar, the allocatable and pointer
attributes can be passed. Otherwise it is 'CFI_attribute_other'*/
@ -5325,18 +5324,6 @@ 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. */
gfc_init_block (&block);
cond = fold_build2_loc (input_location, NE_EXPR,
logical_type_node, cfi_desc_ptr,
build_int_cst (TREE_TYPE (cfi_desc_ptr), 0));
tmp = gfc_call_free (cfi_desc_ptr);
gfc_add_expr_to_block (&block, tmp);
tmp = build3_v (COND_EXPR, cond,
gfc_finish_block (&block),
build_empty_stmt (input_location));
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,
@ -6250,8 +6237,14 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
gfc_add_expr_to_block (&se->pre, tmp);
}
tmp = build_fold_indirect_ref_loc (input_location,
parmse.expr);
tmp = parmse.expr;
/* With bind(C), the actual argument is replaced by a bind-C
descriptor; in this case, the data component arrives here,
which shall not be dereferenced, but still freed and
nullified. */
if (TREE_TYPE(tmp) != pvoid_type_node)
tmp = build_fold_indirect_ref_loc (input_location,
parmse.expr);
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
tmp = gfc_conv_descriptor_data_get (tmp);
tmp = gfc_deallocate_with_status (tmp, NULL_TREE, NULL_TREE,

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2019-10-28 Tobias Burnus <tobias@codesourcery.com>
PR fortran/91863
* gfortran.dg/bind-c-intent-out.f90: New.
2019-10-25 Jiufu Guo <guojiufu@linux.ibm.com>
PR tree-optimization/88760

41
gcc/testsuite/gfortran.dg/bind-c-intent-out.f90 Normal file
View file

@ -0,0 +1,41 @@
! { dg-do compile }
! { dg-options "-fdump-tree-original" }
!
! PR fortran/91863
!
! Contributed by G. Steinmetz
!
subroutine sub(x) bind(c)
implicit none (type, external)
integer, allocatable, intent(out) :: x(:)
allocate(x(3:5))
x(:) = [1, 2, 3]
end subroutine sub
program p
implicit none (type, external)
interface
subroutine sub(x) bind(c)
integer, allocatable, intent(out) :: x(:)
end
end interface
integer, allocatable :: a(:)
call sub(a)
if (.not.allocated(a)) stop 1
if (any(shape(a) /= [3])) stop 2
if (lbound(a,1) /= 3 .or. ubound(a,1) /= 5) stop 3
if (any(a /= [1, 2, 3])) stop 4
end program p
! "cfi" only appears in context of "a" -> bind-C descriptor
! 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
! { 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 "cfi\\.\[0-9\]+ = 0B;" 2 "original" } }