! { dg-do run }
|
! { dg-do run }
|
! { dg-options "-std=legacy" }
|
! { dg-options "-std=legacy" }
|
!
|
!
|
! Program to test character array constructors.
|
! Program to test character array constructors.
|
! PR17144
|
! PR17144
|
subroutine test1 (n, t, u)
|
subroutine test1 (n, t, u)
|
integer n
|
integer n
|
character(len=n) :: s(2)
|
character(len=n) :: s(2)
|
character(len=*) :: t
|
character(len=*) :: t
|
character(len=*) :: u
|
character(len=*) :: u
|
|
|
! A variable array constructor.
|
! A variable array constructor.
|
s = (/t, u/)
|
s = (/t, u/)
|
! An array constructor as part of an expression.
|
! An array constructor as part of an expression.
|
if (any (s .ne. (/"Hell", "Worl"/))) call abort
|
if (any (s .ne. (/"Hell", "Worl"/))) call abort
|
end subroutine
|
end subroutine
|
|
|
subroutine test2
|
subroutine test2
|
character*5 :: s(2)
|
character*5 :: s(2)
|
|
|
! A constant array constructor
|
! A constant array constructor
|
s = (/"Hello", "World"/)
|
s = (/"Hello", "World"/)
|
if ((s(1) .ne. "Hello") .or. (s(2) .ne. "World")) call abort
|
if ((s(1) .ne. "Hello") .or. (s(2) .ne. "World")) call abort
|
end subroutine
|
end subroutine
|
|
|
subroutine test3
|
subroutine test3
|
character*1 s(26)
|
character*1 s(26)
|
character*26 t
|
character*26 t
|
integer i
|
integer i
|
|
|
! A large array constructor
|
! A large array constructor
|
s = (/'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', &
|
s = (/'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', &
|
'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z'/)
|
'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z'/)
|
do i=1, 26
|
do i=1, 26
|
t(i:i) = s(i)
|
t(i:i) = s(i)
|
end do
|
end do
|
|
|
! Assignment with dependency
|
! Assignment with dependency
|
s = (/(s(27-i), i=1, 26)/)
|
s = (/(s(27-i), i=1, 26)/)
|
do i=1, 26
|
do i=1, 26
|
t(i:i) = s(i)
|
t(i:i) = s(i)
|
end do
|
end do
|
if (t .ne. "zyxwvutsrqponmlkjihgfedcba") call abort
|
if (t .ne. "zyxwvutsrqponmlkjihgfedcba") call abort
|
end subroutine
|
end subroutine
|
|
|
program string_ctor_1
|
program string_ctor_1
|
call test1 (4, "Hello", "World")
|
call test1 (4, "Hello", "World")
|
call test2
|
call test2
|
call test3
|
call test3
|
end program
|
end program
|
|
|
|
|