Fortran: array subreferences and components of derived types [PR119986]HEADtrunkmaster

	PR fortran/119986

gcc/fortran/ChangeLog:

	* expr.cc (is_subref_array): When searching for array references,
	do not terminate early so that inquiry references to complex
	components work.
	* primary.cc (gfc_variable_attr): A substring reference can refer
	to either a scalar or array character variable.  Adjust search
	accordingly.

gcc/testsuite/ChangeLog:

	* gfortran.dg/actual_array_subref.f90: New test.

1 files changed, 103 insertions, 0 deletions

diff --git a/gcc/testsuite/gfortran.dg/actual_array_subref.f90 b/gcc/testsuite/gfortran.dg/actual_array_subref.f90
new file mode 100644
index 0000000..932d7ab
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/actual_array_subref.f90
@@ -0,0 +1,103 @@
+! { dg-do run }
+! { dg-additional-options "-O2 -fcheck=bounds" }
+!
+! PR fortran/119986
+!
+! Check passing of inquiry references of complex arrays and substring
+! references of character arrays when these are components of derived types.
+!
+! Extended version of report by Neil Carlson.
+
+program main
+  implicit none
+  integer :: j
+
+  complex, parameter  :: z0(*) = [(cmplx(j,-j),j=1,4)]
+  type :: cx
+     real :: re
+     real :: im
+  end type cx
+  type(cx), parameter :: c0(*) = [(cx   (j,-j),j=1,4)]
+
+  type :: my_type
+     complex  :: z(4) = z0
+     type(cx) :: c(4) = c0
+  end type my_type
+  type(my_type) :: x
+
+  character(*), parameter :: s0(*) = ["abcd","efgh","ijkl","mnop"]
+  character(*), parameter :: expect(*) = s0(:)(2:3)
+  character(len(s0))      :: s1(4) = s0
+
+  type :: str1
+     character(len(s0))   :: s(4)  = s0
+  end type str1
+  type(str1) :: string1
+
+  type :: str2
+     character(:), allocatable :: s(:)
+  end type str2
+  type(str2) :: string2
+
+  integer :: stopcode = 0
+
+  if (len(expect) /= 2)    stop 1
+  if (expect(4)   /= "no") stop 2
+  if (any(c0 %re  /= [ 1, 2, 3, 4])) stop 3
+  if (any(c0 %im  /= [-1,-2,-3,-4])) stop 4
+
+  stopcode = 10
+  call fubar ( x%z %re, x%z %im)
+  call fubar ( x%c %re, x%c %im)
+
+  stopcode = 20
+  call fubar ((x%z %re), (x%z %im))
+  call fubar ((x%c %re), (x%c %im))
+
+  stopcode = 30
+  call fubar ([x%z %re], [x%z %im])
+  call fubar ([x%c %re], [x%c %im])
+
+  stopcode = 50
+  call chk ( s0(:)(2:3) )
+  call chk ((s0(:)(2:3)))
+  call chk ([s0(:)(2:3)])
+
+  stopcode = 60
+  call chk ( s1(:)(2:3) )
+  call chk ((s1(:)(2:3)))
+  call chk ([s1(:)(2:3)])
+
+  stopcode = 70
+  call chk ( string1%s(:)(2:3) )
+  call chk ((string1%s(:)(2:3)))
+  call chk ([string1%s(:)(2:3)])
+
+  string2% s = s0
+  if (len(string2%s) /= 4) stop 99
+  stopcode = 80
+  call chk ( string2%s(:)(2:3) )
+  call chk ((string2%s(:)(2:3)))
+  call chk ([string2%s(:)(2:3)])
+  deallocate (string2% s)
+
+contains
+
+  subroutine fubar(u, v)
+    real, intent(in) :: u(:), v(:)
+    if (any (u /= z0%re)) stop stopcode + 1
+    if (any (v /= z0%im)) stop stopcode + 2
+    if (any (u /= c0%re)) stop stopcode + 3
+    if (any (v /= c0%im)) stop stopcode + 4
+    stopcode = stopcode + 4
+  end subroutine
+
+  subroutine chk (s)
+    character(*), intent(in) :: s(:)
+    if (size(s) /= 4)      stop stopcode + 1
+    if (len (s) /= 2)      stop stopcode + 2
+    if (any (s /= expect)) stop stopcode + 3
+    stopcode = stopcode + 3
+  end subroutine chk
+
+end program