https://gcc.gnu.org/g:eff7e72815ada5c70c974d42f6a419e29a03eb27
commit r15-5701-geff7e72815ada5c70c974d42f6a419e29a03eb27
Author: Harald Anlauf <anl...@gmx.de>
Date: Mon Nov 25 22:55:10 2024 +0100
Fortran: passing inquiry ref of complex array to assumed rank dummy
[PR117774]
PR fortran/117774
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_conv_procedure_call): When passing an array
to an assumed-rank dummy, terminate search for array reference of
actual argument before an inquiry reference (e.g. INQUIRY_RE,
INQUIRY_IM) so that bounds update works properly.
gcc/testsuite/ChangeLog:
* gfortran.dg/assumed_rank_25.f90: New test.
Diff:
---
gcc/fortran/trans-expr.cc | 5 ++-
gcc/testsuite/gfortran.dg/assumed_rank_25.f90 | 51 +++++++++++++++++++++++++++
2 files changed, 55 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index bc1d5a87307d..41d06a99f757 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -7398,7 +7398,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
/* Change AR_FULL to a (:,:,:) ref to force bounds update. */
gfc_ref *ref;
for (ref = e->ref; ref->next; ref = ref->next)
- ;
+ {
+ if (ref->next->type == REF_INQUIRY)
+ break;
+ };
if (ref->u.ar.type == AR_FULL
&& ref->u.ar.as->type != AS_ASSUMED_SIZE)
ref->u.ar.type = AR_SECTION;
diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_25.f90
b/gcc/testsuite/gfortran.dg/assumed_rank_25.f90
new file mode 100644
index 000000000000..fce75aa519f3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_rank_25.f90
@@ -0,0 +1,51 @@
+! { dg-do run }
+! { dg-additional-options "-fcheck=bounds" }
+!
+! PR fortran/117774 - passing imaginary part of complex array to assumed rank
dummy
+
+module mod
+ implicit none
+contains
+ subroutine foo(r, s1, s2)
+ real, intent(in) :: r(..) ! ASSUMED-RANK DUMMY
+ real, intent(in), optional :: s1(:)
+ real, intent(in), optional :: s2(:,:)
+ select rank (r)
+ rank (1)
+! print *, r
+ if (present (s1)) then
+ if (any (r /= s1)) stop 1
+ end if
+ rank (2)
+! print *, r
+ if (present (s2)) then
+ if (any (r /= s2)) stop 2
+ end if
+ end select
+ end subroutine
+end module
+
+program p
+ use mod
+ implicit none
+ real :: re1(3), im1(3)
+ real :: re2(3,7), im2(3,7)
+ complex :: z1(3), z2 (3,7)
+ integer :: i, j
+
+ re1 = [(2*i-1,i=1,size(re1))]
+ im1 = [(2*i ,i=1,size(im1))]
+ z1 = cmplx (re1,im1)
+ call foo (z1 % re, re1)
+ call foo (z1 % im, im1)
+ call foo (z1(2:)% re, re1(2:))
+ call foo (z1(2:)% im, im1(2:))
+
+ re2 = reshape ([ (re1+10*j, j=1,7)], shape (re2))
+ im2 = reshape ([ (im1+10*j, j=1,7)], shape (im2))
+ z2 = cmplx (re2,im2)
+ call foo (z2 % re, s2=re2)
+ call foo (z2 % im, s2=im2)
+ call foo (z2(2:,3:)% re, s2=re2(2:,3:))
+ call foo (z2(2:,3:)% im, s2=im2(2:,3:))
+end
