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 --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index bc1d5a87307dc0a85076baf20237d496fc3c6d52..41d06a99f757d9504fe9ff46e514caca57fca5d7 100644 (file)
--- 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 (file)
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