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
7module m
8  implicit none
9  type test_type
10    integer :: i = 0
11  contains
12    procedure :: ass
13    generic :: assignment(=) => ass
14  end type
15contains
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
21end module
22
23
24program 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
43end
44