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

[Tobias Burnus <tobias at codesourcery dot com>]

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" } }