]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Allow coarrays in select type. [PR46371, PR56496]
authorAndre Vehreschild <vehre@gcc.gnu.org>
Thu, 15 Aug 2024 18:23:23 +0000 (20:23 +0200)
committerAndre Vehreschild <vehre@gcc.gnu.org>
Mon, 19 Aug 2024 09:15:13 +0000 (11:15 +0200)
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
gcc/fortran/trans-stmt.cc
gcc/testsuite/gfortran.dg/coarray/select_type_1.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/coarray/select_type_2.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/coarray/select_type_3.f90 [new file with mode: 0644]

index d3a1f8c0ba10ffad60daee430bd7480441aa47e3..4f2d80c04f85421805281017683ba858051de1a2 100644 (file)
@@ -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);
index 3b09a139dc0baaa2e36bc2a11e8f0f597f64b456..023b1739b858a23ff2a2985874a095f522ab7e92 100644 (file)
@@ -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 (file)
index 0000000..7f12fb9
--- /dev/null
@@ -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
+
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 (file)
index 0000000..1694d09
--- /dev/null
@@ -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
+
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 (file)
index 0000000..50f2789
--- /dev/null
@@ -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
+