+2019-01-24 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/88929
+ * trans-array.c (gfc_conv_descriptor_elem_len): New function.
+ * trans-array.h : Add prototype for above.
+ * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Take account of
+ assumed rank arrays being flagged by rank = -1 in expressions.
+ Intent in arrays need a pointer to a copy of the data to be
+ assigned to the descriptor passed for conversion. This should
+ then be freed, together with the CFI descriptor on return from
+ the C call.
+
2019-01-22 Harald Anlauf <anlauf@gmx.de>
PR fortran/88579
dtype = gfc_conv_descriptor_dtype (desc);
tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_RANK);
- gcc_assert (tmp!= NULL_TREE
+ gcc_assert (tmp != NULL_TREE
&& TREE_TYPE (tmp) == signed_char_type_node);
return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
dtype, tmp, NULL_TREE);
}
+/* Return the element length from the descriptor dtype field. */
+
+tree
+gfc_conv_descriptor_elem_len (tree desc)
+{
+ tree tmp;
+ tree dtype;
+
+ dtype = gfc_conv_descriptor_dtype (desc);
+ tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)),
+ GFC_DTYPE_ELEM_LEN);
+ gcc_assert (tmp != NULL_TREE
+ && TREE_TYPE (tmp) == size_type_node);
+ return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
+ dtype, tmp, NULL_TREE);
+}
+
+
tree
gfc_conv_descriptor_attribute (tree desc)
{
tree gfc_conv_descriptor_span_get (tree);
tree gfc_conv_descriptor_dtype (tree);
tree gfc_conv_descriptor_rank (tree);
+tree gfc_conv_descriptor_elem_len (tree);
tree gfc_conv_descriptor_attribute (tree);
tree gfc_get_descriptor_dimension (tree);
tree gfc_conv_descriptor_stride_get (tree, tree);
tree tmp;
tree cfi_desc_ptr;
tree gfc_desc_ptr;
+ tree ptr = NULL_TREE;
+ tree size;
tree type;
int attribute;
symbol_attribute attr = gfc_expr_attr (e);
attribute = 1;
}
- if (e->rank)
+ if (e->rank != 0)
{
gfc_conv_expr_descriptor (parmse, e);
/* All the temporary descriptors are marked as DECL_ARTIFICIAL. If
the expression type is different from the descriptor type, then
the offset must be found (eg. to a component ref or substring)
- and the dtype updated. */
- type = gfc_typenode_for_spec (&e->ts);
- if (DECL_ARTIFICIAL (parmse->expr)
+ and the dtype updated. Assumed type entities are only allowed
+ to be dummies in Fortran. They therefore lack the decl specific
+ appendiges and so must be treated differently from other fortran
+ entities passed to CFI descriptors in the interface decl. */
+ type = e->ts.type != BT_ASSUMED ? gfc_typenode_for_spec (&e->ts) :
+ NULL_TREE;
+
+ if (type && DECL_ARTIFICIAL (parmse->expr)
&& type != gfc_get_element_type (TREE_TYPE (parmse->expr)))
{
/* Obtain the offset to the data. */
gfc_conv_descriptor_dtype (parmse->expr),
gfc_get_dtype_rank_type (e->rank, type));
}
- else if (!is_subref_array (e) && !DECL_ARTIFICIAL (parmse->expr))
+ else if (type == NULL_TREE
+ || (!is_subref_array (e) && !DECL_ARTIFICIAL (parmse->expr)))
{
/* Make sure that the span is set for expressions where it
might not have been done already. */
- tmp = TREE_TYPE (parmse->expr);
- tmp = TYPE_SIZE_UNIT (gfc_get_element_type (tmp));
+ tmp = gfc_conv_descriptor_elem_len (parmse->expr);
tmp = fold_convert (gfc_array_index_type, tmp);
gfc_conv_descriptor_span_set (&parmse->pre, parmse->expr, tmp);
}
+
+ /* INTENT(IN) requires a temporary for the data. Assumed types do not
+ work with the standard temporary generation schemes. */
+ if (e->expr_type == EXPR_VARIABLE && fsym->attr.intent == INTENT_IN)
+ {
+ /* Fix the descriptor and determine the size of the data. */
+ parmse->expr = gfc_evaluate_now (parmse->expr, &parmse->pre);
+ size = build_call_expr_loc (input_location,
+ gfor_fndecl_size0, 1,
+ gfc_build_addr_expr (NULL, parmse->expr));
+ size = fold_convert (size_type_node, size);
+ tmp = gfc_conv_descriptor_span_get (parmse->expr);
+ tmp = fold_convert (size_type_node, tmp);
+ size = fold_build2_loc (input_location, MULT_EXPR,
+ size_type_node, size, tmp);
+ /* Fix the size and allocate. */
+ size = gfc_evaluate_now (size, &parmse->pre);
+ tmp = builtin_decl_explicit (BUILT_IN_MALLOC);
+ ptr = build_call_expr_loc (input_location, tmp, 1, size);
+ ptr = gfc_evaluate_now (ptr, &parmse->pre);
+ /* Copy the data to the temporary descriptor. */
+ tmp = builtin_decl_explicit (BUILT_IN_MEMCPY);
+ tmp = build_call_expr_loc (input_location, tmp, 3, ptr,
+ gfc_conv_descriptor_data_get (parmse->expr),
+ size);
+ gfc_add_expr_to_block (&parmse->pre, tmp);
+ gfc_conv_descriptor_data_set (&parmse->pre, parmse->expr, ptr);
+ }
+
}
else
{
parmse->expr = build_fold_indirect_ref_loc (input_location,
parmse->expr);
- /* Copy the scalar for INTENT_IN. */
+ /* Copy the scalar for INTENT(IN). */
if (e->expr_type == EXPR_VARIABLE && fsym->attr.intent == INTENT_IN)
parmse->expr = gfc_evaluate_now (parmse->expr, &parmse->pre);
parmse->expr = gfc_conv_scalar_to_descriptor (parmse,
/* The CFI descriptor is passed to the bind_C procedure. */
parmse->expr = cfi_desc_ptr;
+ if (ptr)
+ {
+ /* Free both the temporary data and the CFI descriptor for
+ INTENT(IN) arrays. */
+ tmp = gfc_call_free (ptr);
+ gfc_prepend_expr_to_block (&parmse->post, tmp);
+ tmp = gfc_call_free (cfi_desc_ptr);
+ gfc_prepend_expr_to_block (&parmse->post, tmp);
+ return;
+ }
+
/* Transfer values back to gfc descriptor and free the CFI descriptor. */
tmp = gfc_build_addr_expr (NULL_TREE, parmse->expr);
tmp = build_call_expr_loc (input_location,
+2019-01-24 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/88929
+ * gfortran.dg/ISO_Fortran_binding_3.f90 : New test
+ * gfortran.dg/ISO_Fortran_binding_3.c : Subsidiary source.
+
2019-01-23 H.J. Lu <hongjiu.lu@intel.com>
PR libgcc/88931
2019-01-20 Kewen Lin <linkw@gcc.gnu.org>
- * gcc.target/powerpc/altivec_vld_vst_addr.c: Remove, split into
+ * gcc.target/powerpc/altivec_vld_vst_addr.c: Remove, split into
altivec_vld_vst_addr-1.c and altivec_vld_vst_addr-2.c.
* gcc.target/powerpc/altivec_vld_vst_addr-1.c: New test.
* gcc.target/powerpc/altivec_vld_vst_addr-2.c: Ditto.
--- /dev/null
+#include "../../../libgfortran/ISO_Fortran_binding.h"
+#include <stdio.h>
+#include <stdlib.h>
+
+/* Part of the test for the fix of PR88929 - see ISO_Fortran_binding_3.f90. */
+
+int c_test (CFI_cdesc_t * a_desc)
+{
+ CFI_index_t idx[2];
+ int *res_addr;
+ int err = 1; /* this error code represents all errors */
+
+ if (a_desc->rank != 2)
+ return err;
+
+ if (a_desc->type != CFI_type_int)
+ return err;
+
+ err = 0;
+ for (idx[0] = 0; idx[0] < a_desc->dim[0].extent; idx[0]++)
+ for (idx[1] = 0; idx[1] < a_desc->dim[1].extent; idx[1]++)
+ {
+ res_addr = CFI_address (a_desc, idx);
+ err += *res_addr;
+ *res_addr = *res_addr + 1;
+ }
+
+ if (err != 10) return 1;
+
+ return 0;
+}
+
--- /dev/null
+! { dg-do run }
+! { dg-additional-sources ISO_Fortran_binding_3.c }
+!
+! Test the fix for PR88929.
+!
+ integer, dimension (:,:), allocatable :: actual
+ integer, dimension(2,2) :: src = reshape ([1,2,3,4], [2,2])
+
+ allocate (actual, source = src)
+ ier = test1 (actual)
+ if (ier .ne. 0) stop 1
+! C call is INTENT(IN). 'c_test' increments elements of 'src'.
+ if (any (actual .ne. src)) stop 2
+
+ ier = test2 (actual)
+ if (ier .ne. 0) stop 1
+! C call is INTENT(INOUT) 'c_test' increments elements of 'src'.
+ if (any (actual .ne. src + 1)) stop 2
+
+contains
+
+ function test1 (arg) RESULT(err)
+ USE, INTRINSIC :: ISO_C_BINDING
+ INTEGER(C_INT) :: err
+ type(*), dimension(..), intent(inOUT) :: arg
+ interface
+ function test_c (a) BIND(C, NAME="c_test") RESULT(err)
+ USE, INTRINSIC :: ISO_C_BINDING
+ type(*), dimension(..), intent(in) :: a
+ INTEGER(C_INT) :: err
+ end function
+ end interface
+
+ err = test_c (arg) ! This used to ICE
+
+ end function test1
+
+ function test2 (arg) RESULT(err)
+ USE, INTRINSIC :: ISO_C_BINDING
+ INTEGER(C_INT) :: err
+ type(*), dimension(..), intent(inout) :: arg
+ interface
+ function test_c (a) BIND(C, NAME="c_test") RESULT(err)
+ USE, INTRINSIC :: ISO_C_BINDING
+ type(*), dimension(..), intent(inout) :: a
+ INTEGER(C_INT) :: err
+ end function
+ end interface
+
+ err = test_c (arg) ! This used to ICE
+
+ end function test2
+end
\ No newline at end of file
projects / platform / upstream / gcc.git / commitdiff