1! { dg-do run }
2!
3! PR fortran/19107
4! -fwhole-file flag added for PR fortran/44945
5!
6! This test the fix of PR19107, where character array actual
7! arguments in derived type constructors caused an ICE.
8! It also checks that the scalar counterparts are OK.
9! Contributed by Paul Thomas  pault@gcc.gnu.org
10!
11MODULE global
12  TYPE :: dt
13    CHARACTER(4) a
14    CHARACTER(4) b(2)
15  END TYPE
16  TYPE (dt), DIMENSION(:), ALLOCATABLE, SAVE :: c
17END MODULE global
18program char_array_structure_constructor
19  USE global
20  call alloc (2)
21  if ((any (c%a /= "wxyz")) .OR. &
22      (any (c%b(1) /= "abcd")) .OR. &
23      (any (c%b(2) /= "efgh"))) STOP 1
24contains
25  SUBROUTINE alloc (n)
26    USE global
27    ALLOCATE (c(n), STAT=IALLOC_FLAG)
28    DO i = 1,n
29      c (i) = dt ("wxyz",(/"abcd","efgh"/))
30    ENDDO
31  end subroutine alloc
32END program char_array_structure_constructor
33