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