1! { dg-do run }
2! Tests the fix for pr28167, in which character array constructors
3! with an implied do loop would cause an ICE, when used as actual
4! arguments.
5!
6! Based on the testscase by Harald Anlauf  <anlauf@gmx.de>
7!
8  character(4), dimension(4) :: c1, c2
9  integer m
10  m = 4
11! Test the original problem
12  call foo ((/( 'abcd',i=1,m )/), c2)
13  if (any(c2(:) .ne. (/'abcd','abcd', &
14                            'abcd','abcd'/))) call abort ()
15
16! Now get a bit smarter
17  call foo ((/"abcd", "efgh", "ijkl", "mnop"/), c1) ! worked previously
18  call foo ((/(c1(i), i = m,1,-1)/), c2)            ! was broken
19  if (any(c2(4:1:-1) .ne. c1)) call abort ()
20
21! gfc_todo: Not Implemented: complex character array constructors
22  call foo ((/(c1(i)(i/2+1:i/2+2), i = 1,4)/), c2)  ! Ha! take that..!
23  if (any (c2 .ne. (/"ab  ","fg  ","jk  ","op  "/))) call abort ()
24
25! Check functions in the constructor
26  call foo ((/(achar(64+i)//achar(68+i)//achar(72+i)// &
27               achar(76+i),i=1,4 )/), c1)           ! was broken
28  if (any (c1 .ne. (/"AEIM","BFJN","CGKO","DHLP"/))) call abort ()
29contains
30  subroutine foo (chr1, chr2)
31    character(*), dimension(:) :: chr1, chr2
32    chr2 = chr1
33  end subroutine foo
34end
35