From 205e001e9df7d7b84667a16deee776d2cc8129ca Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Thu, 15 Aug 2024 20:23:23 +0200
Subject: [PATCH] [Fortran] Allow coarrays in select type. [PR46371, PR56496]
Fix ICE when scalar coarrays are used in a select type. Prevent
coindexing in associate/select type/select rank selector expression.
gcc/fortran/ChangeLog:
PR fortran/46371
PR fortran/56496
* expr.cc (gfc_is_coindexed): Detect is coindexed also when
rewritten to caf_get.
* trans-stmt.cc (trans_associate_var): Always accept a
descriptor for coarrays.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/select_type_1.f90: New test.
* gfortran.dg/coarray/select_type_2.f90: New test.
* gfortran.dg/coarray/select_type_3.f90: New test.
---
gcc/fortran/expr.cc | 4 +++
gcc/fortran/trans-stmt.cc | 10 ++----
.../gfortran.dg/coarray/select_type_1.f90 | 34 +++++++++++++++++++
.../gfortran.dg/coarray/select_type_2.f90 | 19 +++++++++++
.../gfortran.dg/coarray/select_type_3.f90 | 23 +++++++++++++
5 files changed, 83 insertions(+), 7 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/select_type_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/coarray/select_type_2.f90
create mode 100644 gcc/testsuite/gfortran.dg/coarray/select_type_3.f90
@@ -5803,6 +5803,10 @@ gfc_is_coindexed (gfc_expr *e)
{
gfc_ref *ref;
+ if (e->expr_type == EXPR_FUNCTION && e->value.function.isym
+ && e->value.function.isym->id == GFC_ISYM_CAF_GET)
+ e = e->value.function.actual->expr;
+
for (ref = e->ref; ref; ref = ref->next)
if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
return !gfc_ref_this_image (ref);
@@ -2200,16 +2200,12 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
else
stmp = gfc_class_data_get (ctmp);
- /* Coarray scalar component expressions can emerge from
- the front end as array elements of the _data field. */
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (stmp)))
- stmp = gfc_conv_descriptor_data_get (stmp);
-
- if (!POINTER_TYPE_P (TREE_TYPE (stmp)))
+ if (!CLASS_DATA (sym)->attr.codimension
+ && !POINTER_TYPE_P (TREE_TYPE (stmp)))
stmp = gfc_build_addr_expr (NULL, stmp);
dtmp = gfc_class_data_get (ctree);
- stmp = fold_convert (TREE_TYPE (dtmp), stmp);
+ stmp = build1 (VIEW_CONVERT_EXPR, TREE_TYPE (dtmp), stmp);
gfc_add_modify (&se.pre, dtmp, stmp);
stmp = gfc_class_vptr_get (ctmp);
dtmp = gfc_class_vptr_get (ctree);
new file mode 100644
@@ -0,0 +1,34 @@
+!{ dg-do run }
+
+! Check PR46371 is fixed.
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+program pr46371
+ type :: foo
+ integer :: i = 0
+ end type
+
+ class(foo), allocatable :: o_foo[:]
+ integer :: j
+
+ allocate(foo :: o_foo[*])
+ if (this_image() == 1) then
+
+ select type(a => o_foo)
+ type is(foo)
+ j = a[1]%i
+ a[1]%i = 3
+ end select
+
+ if (j /= 0) stop 1
+
+ select type(o_foo)
+ type is(foo)
+ j = o_foo[1]%i
+ end select
+
+ if (o_foo[1]%i /= 3) stop 2
+ if (j /= 3) stop 3
+ end if
+end program pr46371
+
new file mode 100644
@@ -0,0 +1,19 @@
+!{ dg-do compile }
+
+! Check PR46371 is fixed.
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+program pr46371
+ type :: foo
+ integer :: i = 0
+ end type
+
+ class(foo), allocatable :: o_foo[:]
+ integer :: j
+
+ select type(a => o_foo[2]) !{ dg-error "must not be coindexed" }
+ type is(foo)
+ j = a%i
+ end select
+end program pr46371
+
new file mode 100644
@@ -0,0 +1,23 @@
+!{ dg-do run }
+
+! Check pr56496 is fixed.
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+program pr56496
+
+ class(*), allocatable :: a[:]
+
+ allocate(integer :: a[*])
+ select type(a)
+ type is (integer)
+ a= 5
+ if (a /= 5) stop 1
+ end select
+
+ select type(a)
+ type is (integer)
+ if (a /= 5) stop 2
+ end select
+
+end
+
--
2.46.0