Hi all,
this patch somehow slipped my attention. Anyone for a review? Third time ping!
Rebased to current mainline.
Regtests ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline?
Regards,
Andre
On Wed, 18 Sep 2024 12:30:23 +0200
Andre Vehreschild <[email protected]> wrote:
> Hi all,
>
> back from my holidays and still no review. PING PING!
>
> Rebased to current mainline.
>
> Regtested ok on x86_64-pc-linux-gnu / F39. Ok for mainline?
>
> Regards,
> Andre
>
> On Wed, 21 Aug 2024 13:43:52 +0200
> Andre Vehreschild <[email protected]> wrote:
>
> > Hi all,
> >
> > pinging this patch for the first time.
> >
> > Rebased and regtested ok on x86_64-pc-linux-gnu / Fedora 39. Ok for
> > mainline?
> >
> > - Andre
> >
> > On Thu, 15 Aug 2024 14:39:25 +0200
> > Andre Vehreschild <[email protected]> wrote:
> >
> > > 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
> >
> >
> > --
> > Andre Vehreschild * Email: vehre ad gmx dot de
>
>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
--
Andre Vehreschild * Email: vehre ad gmx dot de
From 48e77542f0e3342c5da31ecce1b229fa3fbbdaa2 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <[email protected]>
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 9f223a1314a..4065ea2a735 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);
@@ -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),
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index e065e31aaf8..5327ce88813 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 <[email protected]>
+
+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.2
