diff options
author | Harald Anlauf <anlauf@gmx.de> | 2024-11-25 22:55:10 +0100 |
---|---|---|
committer | Harald Anlauf <anlauf@gmx.de> | 2024-11-26 17:06:32 +0100 |
commit | eff7e72815ada5c70c974d42f6a419e29a03eb27 (patch) | |
tree | 75053f850bcf2f9968bf84d65b2f4827532f194c | |
parent | 5134bad11b9a71f869abbb7f3d37b669c6ba138b (diff) | |
download | gcc-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.cc | 5 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/assumed_rank_25.f90 | 51 |
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 |