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.

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index e4c491a98486b89ac793183dfa9ee60bfa088402..9f223a1314a6f2c15de23989a4a4ffd3a9e68e32 100644 (file)
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6438,11 +6438,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,
@@ -6458,7 +6462,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 (file)
index 0000000..378733b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/pr81265.f90
@@ -0,0 +1,74 @@
+!{ dg-do run }
+
+! Contributed by Anton Shterenlikht  <as at cmplx dot uk>
+! 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