1! { dg-do run }
2!
3! PR fortran/65792
4! The evaluation of the argument in the call to new_prt_spec2
5! failed to properly initialize the comp component.
6! While the array contents were properly copied, the array bounds remained
7! uninitialized.
8!
9! Contributed by Dominique D'Humieres <dominiq@lps.ens.fr>
10
11program main
12  implicit none
13
14  integer, parameter :: n = 2
15
16  type :: string_t
17     character(LEN=1), dimension(:), allocatable :: chars
18  end type string_t
19
20  type :: string_container_t
21     type(string_t) :: comp
22  end type string_container_t
23
24  type(string_t) :: prt_in, tmp, tmpa(n)
25  type(string_container_t) :: tmpc, tmpca(n)
26  integer :: i, j, k
27
28  do i=1,2
29
30! scalar elemental function with structure constructor
31     prt_in = string_t(["D"])
32     tmpc = new_prt_spec2 (string_container_t(prt_in))
33     if (any(tmpc%comp%chars .ne. ["D"])) call abort
34     deallocate (prt_in%chars)
35     deallocate(tmpc%comp%chars)
36! Check that function arguments are OK too
37     tmpc = new_prt_spec2 (string_container_t(new_str_t(["h","e","l","l","o"])))
38     if (any(tmpc%comp%chars .ne. ["h","e","l","l","o"])) call abort
39     deallocate(tmpc%comp%chars)
40
41  end do
42
43contains
44
45  impure elemental function new_prt_spec2 (name) result (prt_spec)
46    type(string_container_t), intent(in) :: name
47    type(string_container_t) :: prt_spec
48    prt_spec = name
49  end function new_prt_spec2
50
51
52  function new_str_t (name) result (prt_spec)
53    character (*), intent(in), dimension (:) :: name
54    type(string_t) :: prt_spec
55    prt_spec = string_t(name)
56  end function new_str_t
57
58end program main
59
60