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.



git-svn-id: https://gcc.gnu.org/svn/gcc/trunk@277502 138bc75d-0d04-0410-961f-82ee72b054a4

4 files changed, 62 insertions, 15 deletions

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