aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHarald Anlauf <anlauf@gmx.de>2024-11-25 22:55:10 +0100
committerHarald Anlauf <anlauf@gmx.de>2024-11-26 17:06:32 +0100
commiteff7e72815ada5c70c974d42f6a419e29a03eb27 (patch)
tree75053f850bcf2f9968bf84d65b2f4827532f194c
parent5134bad11b9a71f869abbb7f3d37b669c6ba138b (diff)
downloadgcc-eff7e72815ada5c70c974d42f6a419e29a03eb27.zip
gcc-eff7e72815ada5c70c974d42f6a419e29a03eb27.tar.gz
gcc-eff7e72815ada5c70c974d42f6a419e29a03eb27.tar.bz2
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.
-rw-r--r--gcc/fortran/trans-expr.cc5
-rw-r--r--gcc/testsuite/gfortran.dg/assumed_rank_25.f9051
2 files changed, 55 insertions, 1 deletions
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index bc1d5a8..41d06a9 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 0000000..fce75aa
--- /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