With the trunk, there are three issues:
(a) With bind(C), the callee side handles deallocation with intent(out).
This should produce the code:
if (cfi.0 != 0B)
{
__builtin_free (cfi.0);
cfi.0 = 0B;
}
This fails as cfi.0 (of type 'void*') is dereferenced and
*cfi.0 = 0B' (i.e. assignment of type 'void') causes the ICE.
(b) With that fixed, one gets:
sub (cfi.4);
_gfortran_cfi_desc_to_gfc_desc (&a, &cfi.4);
if (cfi.4 != 0B)
__builtin_free (cfi.4);
... code using "a" ...
That also won't shine as 'a.data' == 'cfi.4'; hence, one
accesses already freed memory.
I don't see whether freeing the cfi memory makes sense at all;
as I didn't come up with a reason, I removed it for good.
Those issues, I have solved. The third issue is now PR fortran/92189:
(c) When allocating memory in a Fortran-written Bind(C) function, the
shape/bounds changes are not propagated back to Fortran.
Namely, "sub" lacks some _gfortran_gfc_desc_to_cfi_desc call at the end!
The issue pops up, if you change 'dg-do compile' into 'dg-do run'. For
using a C-written function, that's a non-issue. Hence, it makes sense
to fix (a)+(b) of the bug separately.
OK for the trunk and GCC 9? (At least the ICE is a regression.)
Tobias
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.
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/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" } }
