gcc/testsuite/gfortran.dg/derived_constructor_comps_5.f90

   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
  11 program 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
  43 contains
  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
  58 end program main
  59