gcc/testsuite/gfortran.dg/derived_constructor_comps_5.f90

! { dg-do run }
!
! PR fortran/65792
! The evaluation of the argument in the call to new_prt_spec2
! failed to properly initialize the comp component.
! While the array contents were properly copied, the array bounds remained
! uninitialized.
!
! Contributed by Dominique D'Humieres <dominiq@lps.ens.fr>

program main
  implicit none

  integer, parameter :: n = 2

  type :: string_t
     character(LEN=1), dimension(:), allocatable :: chars
  end type string_t

  type :: string_container_t
     type(string_t) :: comp
  end type string_container_t

  type(string_t) :: prt_in, tmp, tmpa(n)
  type(string_container_t) :: tmpc, tmpca(n)
  integer :: i, j, k

  do i=1,2

! scalar elemental function with structure constructor
     prt_in = string_t(["D"])
     tmpc = new_prt_spec2 (string_container_t(prt_in))
     if (any(tmpc%comp%chars .ne. ["D"])) STOP 1
     deallocate (prt_in%chars)
     deallocate(tmpc%comp%chars)
! Check that function arguments are OK too
     tmpc = new_prt_spec2 (string_container_t(new_str_t(["h","e","l","l","o"])))
     if (any(tmpc%comp%chars .ne. ["h","e","l","l","o"])) STOP 1
     deallocate(tmpc%comp%chars)

  end do

contains

  impure elemental function new_prt_spec2 (name) result (prt_spec)
    type(string_container_t), intent(in) :: name
    type(string_container_t) :: prt_spec
    prt_spec = name
  end function new_prt_spec2


  function new_str_t (name) result (prt_spec)
    character (*), intent(in), dimension (:) :: name
    type(string_t) :: prt_spec
    prt_spec = string_t(name)
  end function new_str_t

end program main