Hi all,
attached patch fixes a runtime issue when a coarray was passed as
parameter to a procedure that was itself a parameter. The issue here
was that the coarray was passed as array pointer (i.e. w/o descriptor)
to the function, but the function expected it to be an array
w/ descriptor.
Regtests ok on x86_64-pc-linux-gnu / Fedore 39. Ok for mainline?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gcc dot gnu dot org
From 7438255c4988958a03401a24b495637142853e7d Mon Sep 17 00:00:00 2001
From: Andre Vehreschild
Date: Fri, 27 Sep 2024 14:18:42 +0200
Subject: [PATCH] [Fortran] Ensure coarrays in calls use a descriptor [PR81265]
gcc/fortran/ChangeLog:
PR fortran/81265
* trans-expr.cc (gfc_conv_procedure_call): Ensure coarrays use a
descriptor when passed.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/pr81265.f90: New test.
---
gcc/fortran/trans-expr.cc | 8 +-
gcc/testsuite/gfortran.dg/coarray/pr81265.f90 | 74 +++
2 files changed, 81 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/pr81265.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 18ef5e246ce..dbd6547f0fe 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6450,11 +6450,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
{
bool finalized = false;
tree derived_array = NULL_TREE;
+ symbol_attribute *attr;
e = arg->expr;
fsym = formal ? formal->sym : NULL;
parm_kind = MISSING;
+ attr = fsym ? &(fsym->ts.type == BT_CLASS ? CLASS_DATA (fsym)->attr
+ : fsym->attr)
+ : nullptr;
/* If the procedure requires an explicit interface, the actual
argument is passed according to the corresponding formal
argument. If the corresponding formal argument is a POINTER,
@@ -6470,7 +6474,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
if (comp)
nodesc_arg = nodesc_arg || !comp->attr.always_explicit;
else
- nodesc_arg = nodesc_arg || !sym->attr.always_explicit;
+ nodesc_arg
+ = nodesc_arg
+ || !(sym->attr.always_explicit || (attr && attr->codimension));
/* Class array expressions are sometimes coming completely unadorned
with either arrayspec or _data component. Correct that here.
diff --git a/gcc/testsuite/gfortran.dg/coarray/pr81265.f90 b/gcc/testsuite/gfortran.dg/coarray/pr81265.f90
new file mode 100644
index 000..378733bfa7c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/pr81265.f90
@@ -0,0 +1,74 @@
+!{ dg-do run }
+
+! Contributed by Anton Shterenlikht
+! Check PR81265 is fixed.
+
+module m
+implicit none
+private
+public :: s
+
+abstract interface
+ subroutine halo_exchange( array )
+integer, allocatable, intent( inout ) :: array(:,:,:,:)[:,:,:]
+ end subroutine halo_exchange
+end interface
+
+interface
+ module subroutine s( coarray, hx )
+integer, allocatable, intent( inout ) :: coarray(:,:,:,:)[:,:,:]
+procedure( halo_exchange ) :: hx
+ end subroutine s
+end interface
+
+end module m
+submodule( m ) sm
+contains
+module procedure s
+
+if ( .not. allocated(coarray) ) then
+ write (*,*) "ERROR: s: coarray is not allocated"
+ error stop
+end if
+
+sync all
+
+call hx( coarray )
+
+end procedure s
+
+end submodule sm
+module m2
+ implicit none
+ private
+ public :: s2
+ contains
+subroutine s2( coarray )
+ integer, allocatable, intent( inout ) :: coarray(:,:,:,:)[:,:,:]
+ if ( .not. allocated( coarray ) ) then
+write (*,'(a)') "ERROR: s2: coarray is not allocated"
+error stop
+ end if
+end subroutine s2
+end module m2
+program p
+use m
+use m2
+implicit none
+integer, allocatable :: space(:,:,:,:)[:,:,:]
+integer :: errstat
+
+allocate( space(10,10,10,2) [2,2,*], source=0, stat=errstat )
+if ( errstat .ne. 0 ) then
+ write (*,*) "ERROR: p: allocate( space ) )"
+ error stop
+end if
+
+if ( .not. allocated (space) ) then
+ write (*,*) "ERROR: p: space is not allocated"
+ error stop
+end if
+
+call s( space, s2 )
+
+end program p
--
2.46.1
