gcc/testsuite/gfortran.dg/class_12.f03

   1 ! { dg-do compile }
   2 !
   3 ! PR 41556: [OOP] Errors in applying operator/assignment to an abstract type
   4 !
   5 ! Contributed by Damian Rouson <damian@rouson.net>
   6
   7 module abstract_algebra
   8   implicit none
   9   private
  10   public :: rescale
  11   public :: object
  12
  13   type ,abstract :: object
  14   contains
  15     procedure(assign_interface) ,deferred :: assign
  16     procedure(product_interface) ,deferred :: product
  17     generic  :: assignment(=) => assign
  18     generic  :: operator(*) => product
  19   end type
  20
  21   abstract interface
  22     function product_interface(lhs,rhs) result(product)
  23       import :: object
  24       class(object) ,intent(in)  :: lhs
  25       class(object) ,allocatable :: product
  26       real          ,intent(in)  :: rhs
  27     end function
  28     subroutine assign_interface(lhs,rhs)
  29       import :: object
  30       class(object) ,intent(inout) :: lhs
  31       class(object) ,intent(in)    :: rhs
  32     end subroutine
  33   end interface
  34
  35 contains
  36
  37   subroutine rescale(operand,scale)
  38     class(object)    :: operand
  39     real ,intent(in) :: scale
  40     operand = operand*scale
  41     operand = operand%product(scale)
  42   end subroutine
  43 end module