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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7e9531fed4b9d75d9eed0af627a601b06e1e80dc..e77a3a43a5ae01f78694c0f414b01e6a37851d8c 100644 (file)
--- 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 65238ff623de42d620086d8099cdcd2303f89cc4..7eba1bbd0822c078531ded0f362f5a64f0413073 100644 (file)
--- 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 f9f5bb7c1c6596635b697f94542800ccbea05713..c7fbd0e5c09093187bc6443ff814de7234768d95 100644 (file)
--- 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 (file)
index 0000000..493e546
--- /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" } }