gcc/testsuite/gfortran.dg/class_dummy_1.f03

   1 ! { dg-do run }
   2 !
   3 ! PR 44541: [OOP] wrong code for polymorphic variable with INTENT(OUT)/Alloc w/ MOLD
   4 !
   5 ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
   6
   7   implicit none
   8
   9   type t
  10     integer :: a = 1
  11   end type t
  12
  13   type, extends(t) :: t2
  14     integer :: b = 3
  15   end type t2
  16
  17   type(t2) :: y
  18
  19   y%a = 44
  20   y%b = 55
  21   call intent_out (y)
  22   if (y%a/=1 .or. y%b/=3) call abort()
  23
  24   y%a = 66
  25   y%b = 77
  26   call intent_out_unused (y)
  27   if (y%a/=1 .or. y%b/=3) call abort()
  28
  29 contains
  30
  31   subroutine intent_out(x)
  32     class(t), intent(out) :: x
  33     select type (x)
  34       type is (t2)
  35       if (x%a/=1 .or. x%b/=3) call abort()
  36     end select
  37   end subroutine
  38
  39    subroutine intent_out_unused(x)
  40      class(t), intent(out) :: x
  41    end subroutine
  42
  43 end