gcc/testsuite/gfortran.dg/class_allocate_13.f90

   1 ! { dg-do run }
   2 !
   3 ! PR 54784: [4.7/4.8 Regression] [OOP] wrong code in polymorphic allocation with SOURCE
   4 !
   5 ! Contributed by Jeremy Kozdon <jkozdon@gmail.com>
   6
   7 program bug
   8   implicit none
   9
  10   type :: block
  11     real, allocatable :: fields
  12   end type
  13
  14   type :: list
  15     class(block),allocatable :: B
  16   end type
  17
  18   type :: domain
  19     type(list),dimension(2) :: L
  20   end type
  21
  22   type(domain) :: d
  23   type(block) :: b1
  24
  25   allocate(b1%fields,source=5.)
  26
  27   allocate(d%L(2)%B,source=b1)           ! wrong code
  28
  29   if (d%L(2)%B%fields/=5.) call abort()
  30
  31 end program