gcc/testsuite/gfortran.dg/typebound_operator_21.f03

   1 ! { dg-do run }
   2 !
   3 ! Test that pr78395 is fixed.
   4 ! Contributed by Chris MacMackin and Janus Weil
   5
   6 module types_mod
   7   implicit none
   8
   9   type, public :: t1
  10     integer :: a
  11   contains
  12     procedure :: get_t2
  13   end type
  14
  15   type, public :: t2
  16     integer :: b
  17   contains
  18     procedure, pass(rhs) :: mul2
  19     procedure :: assign
  20     generic :: operator(*) => mul2
  21     generic :: assignment(=) => assign
  22   end type
  23
  24 contains
  25
  26   function get_t2(this)
  27     class(t1), intent(in) :: this
  28     class(t2), allocatable :: get_t2
  29     type(t2), allocatable :: local
  30     allocate(local)
  31     local%b = this%a
  32     call move_alloc(local, get_t2)
  33   end function
  34
  35   function mul2(lhs, rhs)
  36     class(t2), intent(in) :: rhs
  37     integer, intent(in) :: lhs
  38     class(t2), allocatable :: mul2
  39     type(t2), allocatable :: local
  40     allocate(local)
  41     local%b = rhs%b*lhs
  42     call move_alloc(local, mul2)
  43   end function
  44
  45   subroutine assign(this, rhs)
  46     class(t2), intent(out) :: this
  47     class(t2), intent(in)  :: rhs
  48     select type(rhs)
  49     type is(t2)
  50       this%b = rhs%b
  51     class default
  52       error stop
  53     end select
  54   end subroutine
  55
  56 end module
  57
  58
  59 program minimal
  60   use types_mod
  61   implicit none
  62
  63   class(t1), allocatable :: v4
  64   class(t2), allocatable :: v6
  65
  66   allocate(v4, source=t1(4))
  67   allocate(v6)
  68   v6 = 3 * v4%get_t2()
  69
  70   select type (v6)
  71     type is (t2)
  72       if (v6%b /= 12) error stop
  73     class default
  74       error stop
  75   end select
  76   deallocate(v4, v6)
  77 end
  78