up/downcasting in fortran 2003? - oop

Question

In fortran 2003, classes and OOP are defined in the standard. I would like to know how upcasting and downcasting is performed.

Answer 1

Actually you can do up-casting (but not down-casting) out-of-the-box using this approach:
PROGRAM main
IMPLICIT NONE
TYPE :: parent
INTEGER :: a
END TYPE parent
TYPE, EXTENDS(parent) :: child
INTEGER :: b
END TYPE child
CLASS(parent), ALLOCATABLE :: p
TYPE(child) :: c
ALLOCATE (p)
p%a = 5
c%a = 10
c%b = 15
PRINT *, p%a
! p = c
DEALLOCATE (p)
ALLOCATE (p, source=c)
PRINT *, p%a
DEALLOCATE (p)
END PROGRAM main
Note:
the variable of type to which you want to up-cast should be polymorphic (CLASS instead of TYPE);
you cannot use intrinsic assignment for polymorphic vars (ALLOCATE instead of =).
ALLOCATE with the source= clause still might be not supported by Intel compiler.
Or you can define an assignment from child type to parent:
MODULE types
IMPLICIT NONE
TYPE :: parent
INTEGER :: a
CONTAINS
PROCEDURE, PRIVATE :: parent_from_child
GENERIC :: ASSIGNMENT(=) => parent_from_child
END TYPE parent
TYPE, EXTENDS(parent) :: child
INTEGER :: b
END TYPE child
CONTAINS
SUBROUTINE parent_from_child(this, c)
CLASS(parent), INTENT(INOUT) :: this
CLASS(child), INTENT(IN) :: c
this%a = c%a
END SUBROUTINE parent_from_child
END MODULE types
In that case you do not need to use polymorphic entities and special form of ALLOCATABLE statement:
PROGRAM main
USE types
IMPLICIT NONE
TYPE(parent) :: p
TYPE(child) :: c
p%a = 5
c%a = 10
c%b = 15
PRINT *, p%a
p = c
PRINT *, p%a
END PROGRAM main
Down-casting... Hmmm... It's unsafe, it's against strong typing discipline. When I faced with down-casting I tsarted to think in the same way - using the same approach. You need to just define another assignment - from parent to child. The only problem will be that if you will use exactly the same scheme (GENERIC binding) child_from_parent will be not distinguishable from parent_from_child. However you can do it in another way:
MODULE types
IMPLICIT NONE
INTERFACE ASSIGNMENT(=)
MODULE PROCEDURE parent_from_child, child_from_parent
END INTERFACE
TYPE :: parent
INTEGER :: a
END TYPE parent
TYPE, EXTENDS(parent) :: child
INTEGER :: b
END TYPE child
CONTAINS
SUBROUTINE parent_from_child(this, c)
TYPE(parent), INTENT(INOUT) :: this
CLASS(child), INTENT(IN) :: c
this%a = c%a
END SUBROUTINE parent_from_child
SUBROUTINE child_from_parent(this, p)
TYPE(child), INTENT(INOUT) :: this
CLASS(parent), INTENT(IN) :: p
this%a = p%a
this%b = 0
END SUBROUTINE child_from_parent
END MODULE types
PROGRAM main
USE types
IMPLICIT NONE
CLASS(parent), ALLOCATABLE :: p
TYPE(child) :: c
c%a = 10
c%b = 15
ALLOCATE (p, source=c)
c%a = 5
PRINT *, c%a
c = p
PRINT *, c%a
END PROGRAM main
But this is not a down-casting. Down-casting is casting a reference to the base class to one of its derived classes. You need to check whether the type of the referenced object is indeed the one being cast to or a derived type of it, and thus issue an error if it is not the case.
Friday night... Good time to do some Fortran. =) Finally I ended up with:
MODULE types
IMPLICIT NONE
TYPE :: parent
INTEGER :: a
END TYPE parent
TYPE, EXTENDS(parent) :: child
INTEGER :: b
END TYPE child
CONTAINS
SUBROUTINE cast(from, to)
CLASS(parent), INTENT(IN) :: from
CLASS(parent), INTENT(INOUT) :: to
SELECT TYPE (to)
TYPE IS (parent)
SELECT TYPE (from)
TYPE IS (parent)
PRINT *, "ordinary assignment"
to = from
TYPE IS (child)
PRINT *, "up-casting"
to%a = from%a
END SELECT
TYPE IS (child)
SELECT TYPE (from)
TYPE IS (parent)
PRINT *, "No way!"
TYPE IS (child)
PRINT *, "down-casting"
to = from
END SELECT
END SELECT
END SUBROUTINE cast
END MODULE types
PROGRAM main
USE types
IMPLICIT NONE
CLASS(parent), ALLOCATABLE :: p1, p2
TYPE(child) :: c1, c2
ALLOCATE (p1, p2)
p1%a = 1
p2%a = 2
c1%a = 1
c1%b = 1
c2%a = 2
c2%b = 2
PRINT *, p1%a
! up-casting from c2 to p1
CALL cast(c2, p1)
PRINT *, p1%a
PRINT *, "----------"
DEALLOCATE (p2)
ALLOCATE (p2, source=c1)
PRINT *, c2%a, c2%b
! down-casting from p2 to c2
CALL cast(p2, c2)
PRINT *, c2%a, c2%b
DEALLOCATE (p1, p2)
END PROGRAM main