procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Allow for class type coarray parameters. [PR77871]

Browse source 
gcc/fortran/ChangeLog:

	PR fortran/77871

	* trans-expr.cc (gfc_conv_derived_to_class): Assign token when
	converting a coarray to class.
	(gfc_get_tree_for_caf_expr): For classes get the caf decl from
	the saved descriptor.
	(gfc_get_caf_token_offset):Assert that coarray=lib is set and
	cover more cases where the tree having the coarray token can be.
	* trans-intrinsic.cc (gfc_conv_intrinsic_caf_get): Use unified
	test for pointers.

gcc/testsuite/ChangeLog:

	* gfortran.dg/coarray/dummy_3.f90: New test.
This commit is contained in:
Andre Vehreschild 2024-08-15 13:49:49 +02:00
parent ec3d3ea60a
commit fd1a2f63bc
3 changed files with 58 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
gcc/fortran/trans-expr.cc
View file

@ -810,6 +810,16 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym,
/* Now set the data field. */
ctree = gfc_class_data_get (var);
if (flag_coarray == GFC_FCOARRAY_LIB && CLASS_DATA (fsym)->attr.codimension)
{
tree token;
tmp = gfc_get_tree_for_caf_expr (e);
if (POINTER_TYPE_P (TREE_TYPE (tmp)))
tmp = build_fold_indirect_ref (tmp);
gfc_get_caf_token_offset (parmse, &token, nullptr, tmp, NULL_TREE, e);
gfc_add_modify (&parmse->pre, gfc_conv_descriptor_token (ctree), token);
}
if (optional)
cond_optional = gfc_conv_expr_present (e->symtree->n.sym);
@ -2344,6 +2354,10 @@ gfc_get_tree_for_caf_expr (gfc_expr *expr)
if (expr->symtree->n.sym->ts.type == BT_CLASS)
{
if (DECL_P (caf_decl) && DECL_LANG_SPECIFIC (caf_decl)
&& GFC_DECL_SAVED_DESCRIPTOR (caf_decl))
caf_decl = GFC_DECL_SAVED_DESCRIPTOR (caf_decl);
if (expr->ref && expr->ref->type == REF_ARRAY)
{
caf_decl = gfc_class_data_get (caf_decl);
@ -2408,16 +2422,12 @@ gfc_get_caf_token_offset (gfc_se *se, tree *token, tree *offset, tree caf_decl,
{
tree tmp;
gcc_assert (flag_coarray == GFC_FCOARRAY_LIB);
/* Coarray token. */
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_decl)))
{
gcc_assert (GFC_TYPE_ARRAY_AKIND (TREE_TYPE (caf_decl))
== GFC_ARRAY_ALLOCATABLE
|| expr->symtree->n.sym->attr.select_type_temporary
|| expr->symtree->n.sym->assoc);
*token = gfc_conv_descriptor_token (caf_decl);
}
else if (DECL_LANG_SPECIFIC (caf_decl)
else if (DECL_P (caf_decl) && DECL_LANG_SPECIFIC (caf_decl)
&& GFC_DECL_TOKEN (caf_decl) != NULL_TREE)
*token = GFC_DECL_TOKEN (caf_decl);
else
@ -2435,7 +2445,7 @@ gfc_get_caf_token_offset (gfc_se *se, tree *token, tree *offset, tree caf_decl,
&& (GFC_TYPE_ARRAY_AKIND (TREE_TYPE (caf_decl)) == GFC_ARRAY_ALLOCATABLE
|| GFC_TYPE_ARRAY_AKIND (TREE_TYPE (caf_decl)) == GFC_ARRAY_POINTER))
*offset = build_int_cst (gfc_array_index_type, 0);
else if (DECL_LANG_SPECIFIC (caf_decl)
else if (DECL_P (caf_decl) && DECL_LANG_SPECIFIC (caf_decl)
&& GFC_DECL_CAF_OFFSET (caf_decl) != NULL_TREE)
*offset = GFC_DECL_CAF_OFFSET (caf_decl);
else if (GFC_TYPE_ARRAY_CAF_OFFSET (TREE_TYPE (caf_decl)) != NULL_TREE)
@ -2502,11 +2512,13 @@ gfc_get_caf_token_offset (gfc_se *se, tree *token, tree *offset, tree caf_decl,
}
else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_decl)))
tmp = gfc_conv_descriptor_data_get (caf_decl);
else if (INDIRECT_REF_P (caf_decl))
tmp = TREE_OPERAND (caf_decl, 0);
else
{
gcc_assert (POINTER_TYPE_P (TREE_TYPE (caf_decl)));
tmp = caf_decl;
}
{
gcc_assert (POINTER_TYPE_P (TREE_TYPE (caf_decl)));
tmp = caf_decl;
}
*offset = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
fold_convert (gfc_array_index_type, *offset),

2
gcc/fortran/trans-intrinsic.cc
View file

@ -1900,7 +1900,7 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
gfc_add_block_to_block (&se->post, &argse.post);
caf_decl = gfc_get_tree_for_caf_expr (array_expr);
if (TREE_CODE (TREE_TYPE (caf_decl)) == REFERENCE_TYPE)
if (POINTER_TYPE_P (TREE_TYPE (caf_decl)))
caf_decl = build_fold_indirect_ref_loc (input_location, caf_decl);
image_index = gfc_caf_get_image_index (&se->pre, array_expr, caf_decl);
gfc_get_caf_token_offset (se, &token, &offset, caf_decl, argse.expr,

33
gcc/testsuite/gfortran.dg/coarray/dummy_3.f90 Normal file
View file

@ -0,0 +1,33 @@
!{ dg-do run }
! Check that PR77871 is fixed.
! Contributed by Gerhard Steinmetz <gerhard.steinmetz.fortran@t-online.de>
program pr77871
type t
integer :: i
end type
type(t) :: p[*]
type(t), allocatable :: p2(:)[:]
p%i = 42
allocate (p2(5)[*])
p2(:)%i = (/(i, i=0, 4)/)
call s(p, 1)
call s2(p2, 1)
contains
subroutine s(x, n)
class(t) :: x[*]
integer :: n
if (x[n]%i /= 42) stop 1
end
subroutine s2(x, n)
class(t) :: x(:)[*]
integer :: n
if (any(x(:)[n]%i /= (/(i, i= 0, 4)/) )) stop 2
end
end