gcc/testsuite/gfortran.dg/transfer_class_2.f90

   1 ! { dg-do run }
   2 !
   3 ! PR 54917: [OOP] TRANSFER on polymorphic variable causes ICE
   4 !
   5 ! Contributed by Janus Weil <janus@gcc.gnu.org>
   6
   7 module m
   8   implicit none
   9   type test_type
  10     integer :: i = 0
  11   contains
  12     procedure :: ass
  13     generic :: assignment(=) => ass
  14   end type
  15 contains
  16   subroutine ass (a, b)
  17     class(test_type), intent(out) :: a
  18     class(test_type), intent(in)  :: b
  19     a%i = b%i
  20   end subroutine
  21 end module
  22
  23
  24 program p
  25   use m
  26   implicit none
  27
  28   class(test_type), allocatable :: c
  29   type(test_type) :: t
  30
  31   allocate(c)
  32
  33   ! (1) check CLASS-to-TYPE transfer
  34   c%i=3
  35   t = transfer(c, t)
  36   if (t%i /= 3) STOP 1
  37
  38   ! (2) check TYPE-to-CLASS transfer
  39   t%i=4
  40   c = transfer(t, c)
  41   if (c%i /= 4) STOP 2
  42
  43 end