Как использовать полиморфный тип данных в качестве атрибута другого типа данных в Fortran

Я создал класс под названием «элемент», который имеет несколько атрибутов и процедур, связанных с типом. Одним из атрибутов является тип абстрактного класса «kin», который имеет два унаследованных типа «kin1» и «kin2». Я хотел бы иметь возможность назначать «kin1» или «kin2» в качестве атрибута «элементу» объекта во время выполнения с помощью конструктора в зависимости от входных данных. Цель состоит в том, чтобы иметь список элементов, каждый из которых имеет element%kin типа 'kin1' или 'kin2'.

Модульный элемент

элемент модуля

использовать родство

implicit none

type,public :: element_type
    class(kin_type),allocatable :: kin
contains
    procedure,pass(this), private :: set_kin
    procedure,pass(this), public  :: get_kin
end type element_type

interface element_type
    module procedure element_type_constructor
end interface element_type

содержит

type (element_type) function element_type_constructor(kin)
    implicit none             
    class(kin_type),allocatable,  intent (in) :: kin    
    call element_type_constructor%set_kin(kin)
end function element_type_constructor

! my try of set_kin
subroutine set_kin(this,kin)
implicit none
class(element_type), intent(inout) :: this
class(kin_type),allocatable, intent(in) :: kin
this%kin = kin
end subroutine

элемент конечного модуля

Род модуля

модуль kin неявный ни один частный

type,abstract :: kin_type
end type kin_type

type,public, extends(kin_type) :: kin1_type
    private
    integer :: data1
contains
    procedure,pass(this),private :: set_data1
    procedure,pass(this),public  :: get_data1
    procedure,pass(this),public  :: print =>print_kin1
end type kin1_type

type,public, extends(kin1_type) :: kin2_type
    private
    real :: data2
contains
    procedure,pass(this),private :: set_data2
    procedure,pass(this),public  :: get_data2
    procedure,pass(this),public  :: print =>print_kin2
end type kin2_type

! constructor interface kin1_type
interface kin1_type
    module procedure kin1_type_constructor
end interface kin1_type

! constructor interface kin2_type
interface kin2_type
    module procedure kin2_type_constructor
end interface kin2_type

содержит

! constructor kin1_type
type (kin1_type) function kin1_type_constructor(data1)
    implicit none
    integer,          intent (in) :: data1                
    class(kin1_type), intent (in) :: kin    
    call kin1_type_constructor%set_data1(data1)
end function kin1_type_constructor

! constructor kin2_type
type (kin2_type) function kin1_type_constructor(data1,data2)
    implicit none
    integer,          intent (in) :: data1 
    real,             intent (in) :: data2               
    class(kin2_type), intent (in) :: kin    
    call kin2_type_constructor%set_data1(data1)
    call kin2_type_constructor%set_data2(data2)
end function kin2_type_constructor


! Example of set subroutine
subroutine set_data1(this,data1)
    class(kin1_type),intent(inout) :: this    
    integer,         intent(in)    :: data1
    this%data1 = data1
end subroutine set_data1

! другие процедуры...

Род конечного модуля

Программа

программный тест

use element
use kin

implicit none
type(element_type) :: thisElement
type(kin1_type)    :: thisKin1

! constructor for thisKin1
thisKin1 = kin1_constructor(data1 = 1)

! constructor for thisElement
thisElement = element_type_constructor(kin = thisKin1)

! Check kin structure and values
call thisElement%kin%print

окончание программы

Ошибка

Я получаю следующую ошибку во время выполнения подпрограммы element_type_constructor: Программа получила сигнал SIGSEGV: ошибка сегментации - неверная ссылка на память.

oop fortran2008

user3618395 04.08.2019 источник

Ответы (1)

arrow_upward
0
arrow_downward

Я пока не могу комментировать, так что вот первый ответ: предоставленный код, к сожалению, неполный. Кроме того, поставщик и версия компилятора отсутствуют, что затрудняет догадку, в чем заключается реальная проблема.

«Исправление» кода для получения следующего примера показывает, что он в принципе работает:

kin.f90:

module kin
    implicit none
    private

    type,abstract,public :: kin_type
    contains
        procedure(print_iface), deferred :: print
    end type kin_type

    type,public, extends(kin_type) :: kin1_type
        private
        integer :: data1
    contains
        procedure,pass(this),private :: set_data1
        procedure,pass(this),public :: print => print_kin1
    end type kin1_type

    ! constructor interface kin1_type
    interface kin1_type
        module procedure kin1_type_constructor
    end interface kin1_type

    abstract interface
        subroutine print_iface(this)
            import kin_type
            class(kin_type), intent(in) :: this
        end subroutine
    end interface
contains

    ! constructor kin1_type
    type (kin1_type) function kin1_type_constructor(data1)
        implicit none
        integer,          intent (in) :: data1
        call kin1_type_constructor%set_data1(data1)
    end function kin1_type_constructor

    ! Example of set subroutine
    subroutine set_data1(this,data1)
    class(kin1_type),intent(inout) :: this
        integer,         intent(in)    :: data1
        this%data1 = data1
    end subroutine set_data1

    subroutine print_kin1(this)
        class(kin1_type),intent(in) :: this
        print *, this%data1
    end subroutine print_kin1

end module kin

элемент.f90:

module element
    use kin, only: kin_type

    implicit none

    type,public :: element_type
        class(kin_type), allocatable :: kin
    contains
        procedure,pass(this), private :: set_kin
    end type element_type

    interface element_type
        module procedure element_type_constructor
    end interface element_type
contains

    type (element_type) function element_type_constructor(kin)
        implicit none
        class(kin_type), intent (in) :: kin
        call element_type_constructor%set_kin(kin)
    end function element_type_constructor

    ! my try of set_kin
    subroutine set_kin(this,kin)
        implicit none
        class(element_type), intent(inout) :: this
        class(kin_type), intent(in) :: kin
        this%kin = kin
    end subroutine
end module element

main.f90:

program test

    use element
    use kin

    implicit none
    type(element_type) :: thisElement
    class(kin_type), allocatable :: thisKin1

    ! constructor for thisKin1
    thisKin1 = kin1_type(data1 = 1)

    ! constructor for thisElement
    thisElement = element_type(kin = thisKin1)

    call thisElement%kin%print()
end program

Собираем его с помощью gfortran 7.4.0 и запускаем:

$ gfortran -o prog kin.f90 element.f90 main.f90
$ ./prog 
           1
$

Одним заметным отличием от того, что было предоставлено, является отложенная процедура print для абстрактного типа, поскольку она вызывается через атрибут, определенный как class(kin_type). К сожалению, это не объясняет приведенную ошибку.

dev-zero 08.08.2019