1! { dg-do run }
2! Tests the fix for PR31219, in which the character length of
3! the functions in the array constructor was not being obtained
4! correctly and this caused an ICE.
5!
6! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
7!
8  INTEGER :: J
9  CHARACTER(LEN = 8) :: str
10  J = 3
11  write (str,'(2A4)') (/( F(I, J), I = 1, 2)/)
12  IF (str .NE. " ODD EVE") call abort ()
13
14! Comment #1 from F-X Coudert (noted by T. Burnus) that
15! actually exercises a different part of the bug.
16  call gee( (/g (3)/) )
17
18CONTAINS
19  FUNCTION F (K,J) RESULT(I)
20    INTEGER :: K, J
21    CHARACTER(LEN = J) :: I
22    IF (MODULO (K, 2) .EQ. 0) THEN
23       I = "EVEN"
24    ELSE
25       I = "ODD"
26    ENDIF
27  END FUNCTION
28
29  function g(k) result(i)
30    integer :: k
31    character(len = k) :: i
32    i = '1234'
33  end function
34  subroutine gee(a)
35    character(*),dimension(1) :: a
36    if(len (a) /= 3) call abort ()
37    if(a(1) /= '123') call abort ()
38  end subroutine gee
39
40END
41