! { dg-do run }
|
! { dg-do run }
|
! Tests the fix for pr28167, in which character array constructors
|
! Tests the fix for pr28167, in which character array constructors
|
! with an implied do loop would cause an ICE, when used as actual
|
! with an implied do loop would cause an ICE, when used as actual
|
! arguments.
|
! arguments.
|
!
|
!
|
! Based on the testscase by Harald Anlauf
|
! Based on the testscase by Harald Anlauf
|
!
|
!
|
character(4), dimension(4) :: c1, c2
|
character(4), dimension(4) :: c1, c2
|
integer m
|
integer m
|
m = 4
|
m = 4
|
! Test the original problem
|
! Test the original problem
|
call foo ((/( 'abcd',i=1,m )/), c2)
|
call foo ((/( 'abcd',i=1,m )/), c2)
|
if (any(c2(:) .ne. (/'abcd','abcd', &
|
if (any(c2(:) .ne. (/'abcd','abcd', &
|
'abcd','abcd'/))) call abort ()
|
'abcd','abcd'/))) call abort ()
|
|
|
! Now get a bit smarter
|
! Now get a bit smarter
|
call foo ((/"abcd", "efgh", "ijkl", "mnop"/), c1) ! worked previously
|
call foo ((/"abcd", "efgh", "ijkl", "mnop"/), c1) ! worked previously
|
call foo ((/(c1(i), i = m,1,-1)/), c2) ! was broken
|
call foo ((/(c1(i), i = m,1,-1)/), c2) ! was broken
|
if (any(c2(4:1:-1) .ne. c1)) call abort ()
|
if (any(c2(4:1:-1) .ne. c1)) call abort ()
|
|
|
! gfc_todo: Not Implemented: complex character array constructors
|
! gfc_todo: Not Implemented: complex character array constructors
|
call foo ((/(c1(i)(i/2+1:i/2+2), i = 1,4)/), c2) ! Ha! take that..!
|
call foo ((/(c1(i)(i/2+1:i/2+2), i = 1,4)/), c2) ! Ha! take that..!
|
if (any (c2 .ne. (/"ab ","fg ","jk ","op "/))) call abort ()
|
if (any (c2 .ne. (/"ab ","fg ","jk ","op "/))) call abort ()
|
|
|
! Check functions in the constructor
|
! Check functions in the constructor
|
call foo ((/(achar(64+i)//achar(68+i)//achar(72+i)// &
|
call foo ((/(achar(64+i)//achar(68+i)//achar(72+i)// &
|
achar(76+i),i=1,4 )/), c1) ! was broken
|
achar(76+i),i=1,4 )/), c1) ! was broken
|
if (any (c1 .ne. (/"AEIM","BFJN","CGKO","DHLP"/))) call abort ()
|
if (any (c1 .ne. (/"AEIM","BFJN","CGKO","DHLP"/))) call abort ()
|
contains
|
contains
|
subroutine foo (chr1, chr2)
|
subroutine foo (chr1, chr2)
|
character(*), dimension(:) :: chr1, chr2
|
character(*), dimension(:) :: chr1, chr2
|
chr2 = chr1
|
chr2 = chr1
|
end subroutine foo
|
end subroutine foo
|
end
|
end
|
|
|