Hi all,
attached patch fixes another regression on coarrays. This time for class typed
coarrays as dummys.
Regtested ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
From d16ef6fe8e792063064d930f1b3ffd31c74594e1 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Thu, 15 Aug 2024 13:49:49 +0200
Subject: [PATCH] [Fortran] Allow for class type coarray parameters. [PR77871]
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.
---
gcc/fortran/trans-expr.cc | 36 ++++++++++++-------
gcc/fortran/trans-intrinsic.cc | 2 +-
gcc/testsuite/gfortran.dg/coarray/dummy_3.f90 | 33 +++++++++++++++++
3 files changed, 58 insertions(+), 13 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/dummy_3.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 8801a15c3a8..4681a131139 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -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);
@@ -2368,6 +2378,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);
@@ -2432,16 +2446,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
@@ -2459,7 +2469,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)
@@ -2526,11 +2536,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),
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 0ecb0439778..586fc65f21d 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -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,
diff --git a/gcc/testsuite/gfortran.dg/coarray/dummy_3.f90 b/gcc/testsuite/gfortran.dg/coarray/dummy_3.f90
new file mode 100644
index 00000000000..4b45daab649
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/dummy_3.f90
@@ -0,0 +1,33 @@
+!{ dg-do run }
+
+! Check that PR77871 is fixed.
+
+! Contributed by Gerhard Steinmetz <gerhard.steinmetz.fort...@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
+
--
2.46.0
