OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/88929 (ICE on building MPICH 3.2 with GCC 9 with ISO_Fortran_binding)

Browse Source 
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-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.

From-SVN: r268231
This commit is contained in:
Paul Thomas 2019-01-24 07:19:49 +00:00
parent 52c9cfeb08
commit db06a76e9a
7 changed files with 179 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/fortran/ChangeLog
View File

@ -1,3 +1,15 @@
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

20
gcc/fortran/trans-array.c
View File

@ -285,13 +285,31 @@ gfc_conv_descriptor_rank (tree desc)
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)
{

1
gcc/fortran/trans-array.h
View File

@ -169,6 +169,7 @@ tree gfc_conv_descriptor_offset_get (tree);
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);

63
gcc/fortran/trans-expr.c
View File

@ -4924,6 +4924,8 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
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);
@ -4939,7 +4941,7 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
attribute = 1;
}
if (e->rank)
if (e->rank != 0)
{
gfc_conv_expr_descriptor (parmse, e);
@ -4950,9 +4952,14 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
/* 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. */
@ -4964,15 +4971,44 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
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
{
@ -4982,7 +5018,7 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
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,
@ -5012,6 +5048,17 @@ 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;
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,

8
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
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
@ -218,7 +224,7 @@
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.

32
gcc/testsuite/gfortran.dg/ISO_Fortran_binding_3.c Normal file
View File

@ -0,0 +1,32 @@
#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;
}

53
gcc/testsuite/gfortran.dg/ISO_Fortran_binding_3.f90 Normal file
View File

@ -0,0 +1,53 @@
! { 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