Object-Oriented Programming

Fortran 2003 added full OOP: type-bound procedures, inheritance, polymorphism, abstract types, and finalizers.

22.1 Type-bound procedures

module shapes_mod
  use, intrinsic :: iso_fortran_env, only: dp => real64
  implicit none
  private
  public :: shape, circle, rectangle

  type, abstract :: shape                        ! abstract base type
    character(len=:), allocatable :: name
  contains
    procedure(area_iface), deferred :: area      ! must be implemented by children
    procedure :: describe                        ! concrete, inherited
  end type shape

  abstract interface
    function area_iface(self) result(a)
      import :: shape, dp
      class(shape), intent(in) :: self
      real(dp) :: a
    end function area_iface
  end interface

  type, extends(shape) :: circle                 ! inheritance
    real(dp) :: r = 1.0_dp
  contains
    procedure :: area => circle_area
  end type circle

  type, extends(shape) :: rectangle
    real(dp) :: w = 1.0_dp, h = 1.0_dp
  contains
    procedure :: area => rect_area
    procedure :: describe => rect_describe       ! override
  end type rectangle

contains

  subroutine describe(self)
    class(shape), intent(in) :: self             ! class(...) = polymorphic dummy argument
    print '(a, " with area ", f0.4)', self%name, self%area()   ! dynamic dispatch
  end
…

22.2 Polymorphic containers

program oop_demo
  use shapes_mod
  implicit none

  type :: shape_holder                          ! wrapper: arrays must be of one declared type
    class(shape), allocatable :: s
  end type shape_holder

  type(shape_holder) :: items(2)
  integer :: i

  items(1)%s = circle(name="circle", r=2.0d0)
  items(2)%s = rectangle(name="rect", w=3.0d0, h=4.0d0)

  do i = 1, size(items)
    call items(i)%s%describe()                  ! dispatches on the dynamic type
  end do
end program oop_demo

22.3 SELECT TYPE

class(shape), allocatable :: s
select type (s)
type is (circle)
  print *, "circle with r =", s%r
type is (rectangle)
  print *, "rectangle", s%w, s%h
class is (shape)
  print *, "some other shape"
class default
  print *, "unknown"
end select

22.4 Unlimited polymorphism: class(*)

Used for generic containers (lists holding any type).

subroutine print_any(x)
  class(*), intent(in) :: x
  select type (x)
  type is (integer);           print *, "integer:", x
  type is (real);              print *, "real:", x
  type is (character(len=*));  print *, "string:", x
  class default;               print *, "unsupported type"
  end select
end subroutine print_any

22.5 Constructors & finalizers

type :: buffer
  real, allocatable :: data(:)
contains
  final :: cleanup                    ! called when the object goes out of scope / is deallocated
end type buffer

interface buffer                      ! custom constructor: generic interface with the type's name
  module procedure new_buffer
end interface

function new_buffer(n) result(b)
  integer, intent(in) :: n
  type(buffer) :: b
  allocate(b%data(n)); b%data = 0.0
end function new_buffer

subroutine cleanup(self)
  type(buffer), intent(inout) :: self
  print *, "finalizing buffer"
end subroutine cleanup

22.6 Other OOP features

non_overridable, nopass (procedure without the passed object), pass(arg).

private components and procedures for encapsulation.

extends chains, extends_type_of(), same_type_as().

allocate(circle :: s) or allocate(s, source=other) / mold= for typed allocation.

Abstract interfaces + deferred bindings = interfaces/"virtual methods".