From 1c02794484c358b1b69363c164ecc39df967eca5 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Mon, 28 Oct 2019 07:33:29 +0000 Subject: [PATCH] Fortran] PR91863 - fix call to bind(C) with array descriptor 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 --- gcc/fortran/ChangeLog | 8 ++++ gcc/fortran/trans-expr.c | 23 ++++------- gcc/testsuite/ChangeLog | 5 +++ .../gfortran.dg/bind-c-intent-out.f90 | 41 +++++++++++++++++++ 4 files changed, 62 insertions(+), 15 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/bind-c-intent-out.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7e9531fed4b..e77a3a43a5a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2019-10-28 Tobias Burnus + + 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 PR fortran/86248 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 65238ff623d..7eba1bbd082 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -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, diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index f9f5bb7c1c6..c7fbd0e5c09 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-10-28 Tobias Burnus + + PR fortran/91863 + * gfortran.dg/bind-c-intent-out.f90: New. + 2019-10-25 Jiufu Guo PR tree-optimization/88760 diff --git a/gcc/testsuite/gfortran.dg/bind-c-intent-out.f90 b/gcc/testsuite/gfortran.dg/bind-c-intent-out.f90 new file mode 100644 index 00000000000..493e546d45d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bind-c-intent-out.f90 @@ -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" } } -- 2.30.2