На самом деле вы можете выполнять приведение (но не приведение) из коробки, используя этот подход:
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
Примечание:
- переменнаятипа, который вы хотите преобразовать, должен быть полиморфным (CLASS вместо TYPE);
- вы не можете использовать внутреннее назначение для полиморфных переменных (ALLOCATE вместо =).
- ALLOCATE спредложение source = все еще может не поддерживаться компилятором Intel.
Или вы можете определить присвоение от дочернего типа к родительскому:
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
В этом случае вам не нужноиспользуйте полиморфные объекты и специальную форму выражения ALLOCATABLE:
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
Понижение рейтинга ... Хммм ... Это небезопасно, это против строгой дисциплины набора текста.Когда я столкнулся с понижением, я начал думать так же, используя тот же подход.Вам нужно просто определить другое назначение - от родителя к ребенку.Единственная проблема заключается в том, что если вы будете использовать точно такую же схему (привязка GENERIC), child_from_parent будет неотличим от parent_from_child.Однако вы можете сделать это по-другому:
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
Но это не понижающий рейтинг.Приведение вниз - это приведение ссылки на базовый класс к одному из его производных классов.Вам нужно проверить, является ли тип ссылочного объекта действительно тем, к которому ведется приведение, или производным типом, и, таким образом, выдать ошибку, если это не так.
Пятница ночью ... Доброе времясделать несколько Фортран.=) Наконец я закончил с:
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