Hi all,
attached patch fixes using of coarrays as dummy arguments. The coarray
dummy argument was not dereferenced correctly, which is fixed now.
Regtests ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline.
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gcc dot gnu dot org
From 374ab1eec7621136de2d9f642b8abf13de197a41 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <[email protected]>
Date: Thu, 11 Jul 2024 10:07:12 +0200
Subject: [PATCH] [Fortran] Fix Rejects allocatable coarray passed as a dummy
argument [88624]
Coarray parameters of procedures/functions need to be dereffed, because
they are references to the descriptor but the routine expected the
descriptor directly.
PR fortran/88624
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_conv_procedure_call): Treat
pointers/references (e.g. from parameters) correctly by derefing
them.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/dummy_1.f90: Add calling function trough
function.
---
gcc/fortran/trans-expr.cc | 35 +++++++++++++------
gcc/testsuite/gfortran.dg/coarray/dummy_1.f90 | 2 ++
2 files changed, 27 insertions(+), 10 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 60495f199dc..0eba029a67a 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -7797,16 +7797,26 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
&& CLASS_DATA (fsym)->attr.codimension
&& !CLASS_DATA (fsym)->attr.allocatable)))
{
- tree caf_decl, caf_type;
+ tree caf_decl, caf_type, caf_desc = NULL_TREE;
tree offset, tmp2;
caf_decl = gfc_get_tree_for_caf_expr (e);
caf_type = TREE_TYPE (caf_decl);
-
- if (GFC_DESCRIPTOR_TYPE_P (caf_type)
- && (GFC_TYPE_ARRAY_AKIND (caf_type) == GFC_ARRAY_ALLOCATABLE
- || GFC_TYPE_ARRAY_AKIND (caf_type) == GFC_ARRAY_POINTER))
- tmp = gfc_conv_descriptor_token (caf_decl);
+ if (POINTER_TYPE_P (caf_type)
+ && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_type)))
+ caf_desc = TREE_TYPE (caf_type);
+ else if (GFC_DESCRIPTOR_TYPE_P (caf_type))
+ caf_desc = caf_type;
+
+ if (caf_desc
+ && (GFC_TYPE_ARRAY_AKIND (caf_desc) == GFC_ARRAY_ALLOCATABLE
+ || GFC_TYPE_ARRAY_AKIND (caf_desc) == GFC_ARRAY_POINTER))
+ {
+ tmp = POINTER_TYPE_P (TREE_TYPE (caf_decl))
+ ? build_fold_indirect_ref (caf_decl)
+ : caf_decl;
+ tmp = gfc_conv_descriptor_token (tmp);
+ }
else if (DECL_LANG_SPECIFIC (caf_decl)
&& GFC_DECL_TOKEN (caf_decl) != NULL_TREE)
tmp = GFC_DECL_TOKEN (caf_decl);
@@ -7819,8 +7829,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
vec_safe_push (stringargs, tmp);
- if (GFC_DESCRIPTOR_TYPE_P (caf_type)
- && GFC_TYPE_ARRAY_AKIND (caf_type) == GFC_ARRAY_ALLOCATABLE)
+ if (caf_desc
+ && GFC_TYPE_ARRAY_AKIND (caf_desc) == GFC_ARRAY_ALLOCATABLE)
offset = build_int_cst (gfc_array_index_type, 0);
else if (DECL_LANG_SPECIFIC (caf_decl)
&& GFC_DECL_CAF_OFFSET (caf_decl) != NULL_TREE)
@@ -7830,8 +7840,13 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
else
offset = build_int_cst (gfc_array_index_type, 0);
- if (GFC_DESCRIPTOR_TYPE_P (caf_type))
- tmp = gfc_conv_descriptor_data_get (caf_decl);
+ if (caf_desc)
+ {
+ tmp = POINTER_TYPE_P (TREE_TYPE (caf_decl))
+ ? build_fold_indirect_ref (caf_decl)
+ : caf_decl;
+ tmp = gfc_conv_descriptor_data_get (tmp);
+ }
else
{
gcc_assert (POINTER_TYPE_P (caf_type));
diff --git a/gcc/testsuite/gfortran.dg/coarray/dummy_1.f90 b/gcc/testsuite/gfortran.dg/coarray/dummy_1.f90
index 33e95853ad4..c437b2a10fc 100644
--- a/gcc/testsuite/gfortran.dg/coarray/dummy_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/dummy_1.f90
@@ -66,5 +66,7 @@
if (lcobound(A, dim=1) /= 2) STOP 13
if (ucobound(A, dim=1) /= 3) STOP 14
if (lcobound(A, dim=2) /= 5) STOP 15
+
+ call sub4(A) ! Check PR88624 is fixed.
end subroutine sub5
end
--
2.45.2
