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