Search code examples
fortranfortran2003

How do I overload an operator for a derived type which extends an abstract type?


I take an example from "Fortran 95/2003 explained" by Metcalf et al, since m own code aims for the same thing.

type, abstract :: my_numeric_type
contains
    private
    procedure(op2), deferred :: add
    generic, public :: operator(+) => add
end type

abstract interface
    function op2(a,b) result (r)
        import :: my_numeric_type
        class(my_numeric type), intent(in) :: a,b
        class(my_numeric type), allocatable :: r
    end function op2
end interface

type, extends(my_numeric_type) :: my_integer
    integer, private :: value
contains
    procedure :: add => add_my_integer
end type

Now, my question is how do I properly implement the add_my_integer function. It seems like I am forced to cast the first argument as my_integer since it is a type bound procedure, but the second one has to be my_numeric_type to be compliant with the abstract interface. As for the result, should I allocate r to my_integer? here is what I came up with so far, it does compile, but it seems weird to check for type all the time, and it causes a segmentation fault (perhaps due to some other problem with my code though).

function add_my_integer(a,b) result(r)
    class(my_integer), intent(in) :: a
    class(my_numeric_type), intent(in) :: b
    class(my_numeric_type), allocatable :: r

    allocate(my_integer :: r)
    select type (b)
        type is (my_integer)
            r = a+b
    end select
end function

Solution

  • This works for me, but it looks quite complicated (too many select type). I made the value public for easy output only, otherwise you want a custom getter and setter.

    module num
    
      type, abstract :: my_numeric_type
      contains
          private
          procedure(op2), deferred :: add
          generic, public :: operator(+) => add
          procedure(op), deferred :: ass
          generic, public :: assignment(=) => ass
      end type
    
      abstract interface
          subroutine op(a,b)
              import :: my_numeric_type
              class(my_numeric_type), intent(out) :: a
              class(my_numeric_type), intent(in) :: b
          end subroutine op
          function op2(a,b) result (r)
              import :: my_numeric_type
              class(my_numeric_type), intent(in) :: a,b
              class(my_numeric_type), allocatable :: r
          end function op2
    
      end interface
    
      type, extends(my_numeric_type) :: my_integer
          integer, public :: value
      contains
          procedure :: add => add_my_integer
          procedure :: ass => ass_my_integer
      end type
    
      contains
    
        function add_my_integer(a,b) result(r)
            class(my_integer), intent(in) :: a
            class(my_numeric_type), intent(in) :: b
            class(my_numeric_type), allocatable :: r
    
            select type (b)
                type is (my_integer)
                    allocate(my_integer :: r)
                    select type (r)
                      type is (my_integer)
                        r%value = a%value+b%value
                    end select
            end select
        end function
    
    
        subroutine ass_my_integer(a,b)
            class(my_integer), intent(out) :: a
            class(my_numeric_type), intent(in) :: b
    
            select type (b)
                type is (my_integer)
                        a%value = b%value
            end select
        end subroutine
    
    end module
    
    program main
      use num
    
      class(my_integer), allocatable :: a, b, c
      allocate(my_integer :: a)
      allocate(my_integer :: b)
      allocate(my_integer :: c)
      a=my_integer(1)
      b=my_integer(2)
      c = a+b
      write (*,*) c%value
    end program