Here is a problem which is not only found in Fortran, but in all non memory-managed languages: who is in charge of deleting an object? All this stuff can be handled in C++ with plenty of off-the-shelf features, such as destructors and some STL/Boost classes, but nothing exists like that exists for Fortran. We will have to reinvent the wheel.
One option, and the one I stuck with for a while, was to bless object e.g.
Car with the magic duty to delete its dependent object
Engine. That means,
Engine, and the life of
Engine depends on the life of
Car is deleted,
Engine is deleted. If another object
EngineList is interested in
Engine, we have three choices
EngineListgets a pointer to
Carand stores it, or
EngineListsteals the responsibility from
Engine, that is, ownership is transferred from
EngineListgets a copy of
Engine, and is now responsible of managing the life of the copy.
Enginecollaborate in a reference counting mechanism. Either
Carcan issue a “deletion request” but only when no object is left referencing
Engine, this will be deleted.
This is a trivial example of course, and depending on the actual names and roles of the types involved, one solution may be better and more intuitive than another. Keep this example as a general guide,
With the first solution, if you delete
Car later in your code,
Engine is also deleted. This makes the pointer in
EngineList invalid. Using this pointer will lead to a crash. To prevent this, you have to plan for a proper allocation strategy: all objects always store a pointer and never own the object, and delegate the responsibility for deletion (and therefore lifetime) to someone else. For example, you may have an
Application object who owns the
Engine and therefore the responsibility of deleting it, guaranteeing a proper lifetime for all your entities.
Application then creates
Car and sets the
Engine, so that
Engine survives until
Application survives. This is apparently a fair solution, but it makes
Application aware of a problem and in charge of a responsibility which is there just because of technical problem, not because it has a real domain need to know about these details.
The second solution, transferring ownership, leaves a
Car without the
Engine. I generally relied on this solution because it generally worked ok, but for this specific example is probably not the best choice. In any case, the main idea is to move the responsibility for deletion from one object to another. I generally handled one-to-one interest: only one object A was interested in another object B. When a new object C was interested in B, A also lost interest in it, and it made sense within that context. To do this, I implemented two methods on the objects:
Grab. In our example it would be
module EngineModule implicit none private public :: EngineType public :: new, delete type EngineType integer :: horsePower end type interface new module procedure newImpl end interface interface delete module procedure deleteImpl end interface contains subroutine newImpl(self, horsePower) type (EngineType), intent(inout) :: self integer, intent(in) :: horsePower self%horsePower = horsePower end subroutine subroutine deleteImpl(self) type (EngineType), intent(inout) :: self ! nothing to do. end subroutine end module
This is the Car
module CarModule use EngineModule implicit none private public :: CarType public :: new, delete, relinquishEngine type CarType type(EngineType), pointer :: engine => null() end type interface new module procedure newImpl end interface interface delete module procedure deleteImpl end interface contains subroutine newImpl(self) type (CarType), intent(inout) :: self if (associated(self%engine)) then ! handle error, double instantiation endif allocate(self%engine) call New(self%engine, 40) end subroutine subroutine deleteImpl(self) type (CarType), intent(inout) :: self if (associated(self%engine)) then call Delete(self%engine) deallocate(self%engine) nullify(self%engine) endif end subroutine function relinquishEngine(self) result(enginePtr) type (CarType), intent(inout) :: self type (EngineType), pointer :: enginePtr enginePtr => self%engine ! give it out nullify(self%engine) ! no longer the owner end subroutine end module
Note how the
deleteImpl routine deletes the engine member only if the pointer is associated, and how the relinquish function returns the pointer and nullifies the current member. This is the first part of ownership transfer. The second part is in ownership acquisition in the
EngineList grab routine
subroutine grabEngine(self, enginePtr) ! takes ownership of an engine object (which has been relinquished by someone else) type(EngineListType), intent(inout) :: self type(EngineType), pointer :: enginePtr self%engine => enginePtr end subroutine
With reference counting:
module RefCount implicit none type ObjectType integer :: refCount = 0 integer, pointer :: data(:) end type type ObjectRefType type (ObjectType), pointer :: object => null() end type interface New module procedure NewObject end interface interface Ref module procedure NewRefFromObject module procedure NewRefFromRef end interface interface Delete module procedure DeleteObject module procedure DeleteRef end interface interface Deref module procedure DerefPrivate end interface contains subroutine NewObject(self) type (ObjectType), intent(inout) :: self print *, "New Object" allocate(self%data(10)) self%data = 1.0 self%RefCount = 0 end subroutine subroutine DeleteObject(self) type (ObjectType), intent(inout) :: self if (self%refCount /= 0) print *, "refcount .not. zero. Big mistake!" print *, "Deleting object" deallocate(self%data) end subroutine function NewRefFromObject(object) result(ref) type (ObjectType), pointer :: object type (ObjectRefType), pointer :: Ref allocate(Ref) Ref%object => object Ref%object%refCount = Ref%object%refCount + 1 print *, "New reference. Count = ", Ref%object%refCount end function function NewRefFromRef(ref) result(newref) type (ObjectRefType), pointer :: ref type (ObjectRefType), pointer :: newref allocate(NewRef) NewRef%object => ref%object NewRef%object%refCount = NewRef%object%refCount + 1 print *, "New reference. Count = ", NewRef%object%refCount end function subroutine DeleteRef(ref) type (ObjectRefType), pointer :: ref ref%object%refCount = ref%object%refCount - 1 if (ref%object%refCount == 0) then print *, "Deleting object. Reference count dropped to zero" call Delete(ref%object) deallocate(ref%object) deallocate(ref) return endif print *, "Unreferencing. Reference count dropped to ",ref%object%refCount end subroutine function DerefPrivate(ref) type (ObjectRefType), pointer :: ref type (ObjectType), pointer :: DerefPrivate DerefPrivate => ref%object end function end module program m use RefCount type (ObjectType), pointer :: object, objectPtr type (ObjectRefType), pointer :: ref1, ref2, ref3 allocate(object) call New(object) object%data = 10.0 ref1 => Ref(object) ref2 => Ref(object) ref3 => Ref(ref1) objectPtr => deRef(ref3) objectPtr%data = 2.0 objectPtr => deRef(ref2) print *, objectPtr%data call Delete(ref1) call Delete(ref2) call Delete(ref3) end