Hi all,
attached patches fix a 12-regression, when a caf token is requested from an
abstract class-typed dummy. The token was not looked up in the correct spot.
Due the class typed object getting an artificial variable for direct derived
type access, the get_caf_decl was looking at the wrong decl.
This patch consists of two parts, the first is just some code complexity
reduction, where an existing attr is now used instead of checking for BT_CLASS
type and branching.
Regtests ok on x86_64-pc-linux-gnu / F41. Ok for mainline?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
From 9b7aeeef184b1e7afbc771e4ef723e4367e8f832 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Mon, 3 Mar 2025 14:42:28 +0100
Subject: [PATCH 2/2] Fortran: Prevent ICE when getting caf-token from abstract
type [PR77872]
PR fortran/77872
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_get_tree_for_caf_expr): Pick up token from
decl when it is present there for class types.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/class_1.f90: New test.
---
gcc/fortran/trans-expr.cc | 5 +++++
gcc/testsuite/gfortran.dg/coarray/class_1.f90 | 16 ++++++++++++++++
2 files changed, 21 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/class_1.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 7c0b17428cd..0d790b63f95 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -2394,6 +2394,11 @@ gfc_get_tree_for_caf_expr (gfc_expr *expr)
if (CLASS_DATA (expr->symtree->n.sym)->attr.codimension)
return caf_decl;
}
+ else if (DECL_P (caf_decl) && DECL_LANG_SPECIFIC (caf_decl)
+ && GFC_DECL_TOKEN (caf_decl)
+ && CLASS_DATA (expr->symtree->n.sym)->attr.codimension)
+ return caf_decl;
+
for (ref = expr->ref; ref; ref = ref->next)
{
if (ref->type == REF_COMPONENT
diff --git a/gcc/testsuite/gfortran.dg/coarray/class_1.f90 b/gcc/testsuite/gfortran.dg/coarray/class_1.f90
new file mode 100644
index 00000000000..fa70b1d6162
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/class_1.f90
@@ -0,0 +1,16 @@
+!{ dg-do compile }
+!
+! Compiling the call x%f() ICEd. Check it's fixed.
+! Contributed by Gerhard Steinmetz <gerhard.steinmetz.fort...@t-online.de>
+
+module pr77872_abs
+ type, abstract :: t
+ contains
+ procedure(s), pass, deferred :: f
+ end type
+contains
+ subroutine s(x)
+ class(t) :: x[*]
+ call x%f()
+ end
+end module pr77872_abs
--
2.48.1
From 504b6270f535bf41ba5943d87e6bbbf7fc1df62a Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Mon, 3 Mar 2025 10:41:05 +0100
Subject: [PATCH 1/2] Fortran: Reduce code complexity [PR77872]
PR fortran/77872
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_conv_procedure_call): Use attr instead of
doing type check and branching for BT_CLASS.
---
gcc/fortran/trans-expr.cc | 14 +++-----------
1 file changed, 3 insertions(+), 11 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index e619013f261..7c0b17428cd 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -8216,23 +8216,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
/* For descriptorless coarrays and assumed-shape coarray dummies, we
pass the token and the offset as additional arguments. */
if (fsym && e == NULL && flag_coarray == GFC_FCOARRAY_LIB
- && ((fsym->ts.type != BT_CLASS && fsym->attr.codimension
- && !fsym->attr.allocatable)
- || (fsym->ts.type == BT_CLASS
- && CLASS_DATA (fsym)->attr.codimension
- && !CLASS_DATA (fsym)->attr.allocatable)))
+ && attr->codimension && !attr->allocatable)
{
/* Token and offset. */
vec_safe_push (stringargs, null_pointer_node);
vec_safe_push (stringargs, build_int_cst (gfc_array_index_type, 0));
gcc_assert (fsym->attr.optional);
}
- else if (fsym && flag_coarray == GFC_FCOARRAY_LIB
- && ((fsym->ts.type != BT_CLASS && fsym->attr.codimension
- && !fsym->attr.allocatable)
- || (fsym->ts.type == BT_CLASS
- && CLASS_DATA (fsym)->attr.codimension
- && !CLASS_DATA (fsym)->attr.allocatable)))
+ else if (fsym && flag_coarray == GFC_FCOARRAY_LIB && attr->codimension
+ && !attr->allocatable)
{
tree caf_decl, caf_type, caf_desc = NULL_TREE;
tree offset, tmp2;
--
2.48.1
