blob: 932d7aba1214880ebeb807dc5d91ebb9cb7eb79c [file] [log] [blame]
! { 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