gcc/testsuite/gfortran.dg/allocate_with_source_11.f08

   1 !{ dg-do run }
   2 !
   3 ! Testcase for pr66927, pr67123
   4 ! Contributed by Juergen Reuter <juergen.reuter@desy.de>
   5
   6 module processes
   7   implicit none
   8   private
   9
  10   type :: t1_t
  11      real :: p = 0.0
  12   end type t1_t
  13
  14   type :: t2_t
  15      private
  16      type(t1_t), dimension(:), allocatable :: p
  17    contains
  18      procedure :: func => t2_func
  19   end type t2_t
  20
  21   type, public :: t3_t
  22     type(t2_t), public :: int_born
  23   end type t3_t
  24
  25   public :: evaluate
  26
  27 contains
  28
  29   function t2_func (int) result (p)
  30     class(t2_t), intent(in) :: int
  31     class(t1_t), dimension(:), allocatable :: p
  32     allocate(p(5))
  33   end function t2_func
  34
  35   subroutine evaluate (t3)
  36     class(t3_t), intent(inout) :: t3
  37     type(t1_t), dimension(:), allocatable :: p_born
  38     allocate (p_born(1:size(t3%int_born%func ())), &
  39          source = t3%int_born%func ())
  40     if (.not. allocated(p_born)) STOP 1
  41     if (size(p_born) /= 5) STOP 2
  42   end subroutine evaluate
  43
  44 end module processes
  45
  46 program pr66927
  47 use processes
  48 type(t3_t) :: o
  49 call evaluate(o)
  50 end
  51