https://gcc.gnu.org/g:8871489c5162067c72a9b9ab05fe2179560e9986
commit r15-3020-g8871489c5162067c72a9b9ab05fe2179560e9986 Author: Andre Vehreschild <ve...@gcc.gnu.org> Date: Thu Aug 15 20:23:23 2024 +0200 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. Diff: --- 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(-) diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index d3a1f8c0ba1..4f2d80c04f8 100644 --- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -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); diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc index 3b09a139dc0..023b1739b85 100644 --- a/gcc/fortran/trans-stmt.cc +++ b/gcc/fortran/trans-stmt.cc @@ -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); diff --git a/gcc/testsuite/gfortran.dg/coarray/select_type_1.f90 b/gcc/testsuite/gfortran.dg/coarray/select_type_1.f90 new file mode 100644 index 00000000000..7f12fb9aec7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/select_type_1.f90 @@ -0,0 +1,34 @@ +!{ dg-do run } + +! Check PR46371 is fixed. +! Contributed by Tobias Burnus <bur...@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 + diff --git a/gcc/testsuite/gfortran.dg/coarray/select_type_2.f90 b/gcc/testsuite/gfortran.dg/coarray/select_type_2.f90 new file mode 100644 index 00000000000..1694d095708 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/select_type_2.f90 @@ -0,0 +1,19 @@ +!{ dg-do compile } + +! Check PR46371 is fixed. +! Contributed by Tobias Burnus <bur...@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 + diff --git a/gcc/testsuite/gfortran.dg/coarray/select_type_3.f90 b/gcc/testsuite/gfortran.dg/coarray/select_type_3.f90 new file mode 100644 index 00000000000..50f27893ccc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/select_type_3.f90 @@ -0,0 +1,23 @@ +!{ dg-do run } + +! Check pr56496 is fixed. +! Contributed by Tobias Burnus <bur...@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 +