How can you overload an operator for a derived type that extends an abstract type?

I am taking an example from Fortran 95/2003 explained by Metcalfe et al, since the native 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 to properly implement the function add_my_integer

. It seems that I am forced to pass the first argument as my_integer

, since it is a type-bound procedure, but the second must be my_numeric_type

in order to fit the abstract interface. As for the result, should we highlight r

on my_integer

? here is what i have come up with so far, it compiles but it seems strange to check the type all the time and it causes a segmentation fault (possibly due to some other problem with my code).

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

      

+3


source to share


1 answer


This works for me, but it looks rather complicated (too much select type

). I made the value public for simple output, otherwise you want to use 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

      

+4


source







All Articles