Конструктор производных типов

Question

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

Цель состоит в том, чтобы во время выполнения полиморфизм устанавливал правильное количество ног животного.

Это два модуля:

животное

module animal_module
    implicit none

    type, abstract :: animal
        private
        integer, public :: nlegs = -1
    contains
        procedure :: legs
    end type animal

contains

    function legs(this) result(n)
        class(animal), intent(in) :: this
        integer :: n

        n = this%nlegs
    end function legs

кошка

module cat_module
    use animal_module, only : animal
    implicit none

    type, extends(animal) :: cat
        private
    contains
        procedure :: setlegs => setlegs
    end type cat

    interface cat
        module procedure init_cat
    end interface cat

contains

    type(cat) function init_cat(this)
        class(cat), intent(inout) :: this
        print *, "Cat!"
        this%nlegs = -4
    end function init_cat

основная программа

program oo
    use animal_module
    use cat_module
    implicit none

    type(cat) :: c
    type(bee) :: b

    character(len = 3) :: what = "cat"

    class(animal), allocatable :: q

    select case(what)
    case("cat")
        print *, "you will see a cat"
        allocate(cat :: q)
        q = cat() ! <----- this line does not change anything

    case default
        print *, "ohnoes, nothing is prepared!"
        stop 1
    end select

    print *, "this animal has ", q%legs(), " legs."
    print *, "cat  animal has ", c%legs(), " legs."
end program

Конструктор isn 'коллируется, а количество ног до сих пор остается -1.

Answer 1

Доступный конструктор не по умолчанию для типа cat задается процедурой модуля init_cat. Эта функция, которую вы определили как

type(cat) function init_cat(this)
    class(cat), intent(inout) :: this
end function init_cat

Это функция с одним аргументом class(cat). В вашей более поздней ссылке

q = cat()

В обобщенном cat нет конкретной функции, соответствующей этой ссылке: функция init_cat не принимает ссылку без аргументов. Вместо этого используется конструктор структуры по умолчанию.

Вы должны ссылаться на универсальный cat способом, соответствующим интерфейсу init_cat, чтобы эта конкретная функция вызывалась.

Вы хотите изменить свой init_cat функция выглядит как

type(cat) function init_cat()
    ! print*, "Making a cat"
    init_cat%nlegs = -4
end function init_cat

Затем вы можете ссылаться на q=cat() по желанию.

Обратите внимание, что в оригинале вы пытаетесь "создать" экземпляр cat,но вы не возвращаете эту созданную сущность как результат функции. Вместо этого вы модифицируете аргумент (уже создан). Структурные конструкторы предназначены для использования, возвращая такие полезные вещи.

Обратите также внимание, что вам не нужно

allocate (cat :: q)
q = cat()

Внутреннее присваивание q уже обрабатывает qраспределение.

Answer 2

FWIW, вот пример кода, сравнивающий три подхода (метод = 1: распределение по источнику, 2: полиморфное назначение, 3: смешанный подход).

module animal_module
    implicit none

    type, abstract :: animal_t
        integer :: nlegs = -1
    contains
        procedure :: legs   !! defines a binding to some procedure
    endtype

contains
    function legs(this) result(n)
        class(animal_t), intent(in) :: this
            !! The passed variable needs to be declared as "class"
            !! to use this routine as a type-bound procedure (TBP).
        integer :: n
        n = this % nlegs
    end
end

module cat_module
    use animal_module, only : animal_t
    implicit none

    type, extends(animal_t) :: cat_t
    endtype

    interface cat_t   !! overloads the definition of cat_t() (as a procedure)
        module procedure make_cat
    end interface

contains
    function make_cat() result( ret )   !! a usual function
        type(cat_t) :: ret   !<-- returns a concrete-type object
        ret % nlegs = -4
    end
end

program main
    use cat_module, only: cat_t, animal_t
    implicit none
    integer :: method

    type(cat_t) :: c
    class(animal_t), allocatable :: q

    print *, "How to create a cat? [method = 1,2,3]"
    read *, method

    select case ( method )
        case ( 1 )
            print *, "1: sourced allocation"

            allocate( q, source = cat_t() )

            !! An object created by a function "cat_t()" is used to
            !! allocate "q" with the type and value taken from source=.
            !! (Empirically most stable for different compilers/versions.)

        case ( 2 )
            print *, "2: polymorphic assignment"

            q = cat_t()

            !! Similar to sourced allocation. "q" is automatically allocated.
            !! (Note: Old compilers may have bugs, so tests are recommended...)

        case ( 3 )
            print *, "3: mixed approach"

            allocate( cat_t :: q )
            q = cat_t()

            !! First allocate "q" with a concrete type "cat_t"
            !! and then assign a value obtained from cat_t().

        case default ; stop "unknown method"
    endselect

    c = cat_t()
    !! "c" is just a concrete-type variable (not "allocatable")
    !! and assigned with a value obtained from cat_t().

    print *, "c % legs() = ", c % legs()
    print *, "q % legs() = ", q % legs()
end

--------------------------------------------------
Test

$ gfortran test.f90   # using version 8 or 9

$ echo 1 | ./a.out
 How to create a cat? [method = 1,2,3]
 1: sourced allocation
 c % legs() =           -4
 q % legs() =           -4

$ echo 2 | ./a.out
 How to create a cat? [method = 1,2,3]
 2: polymorphic assignment
 c % legs() =           -4
 q % legs() =           -4

$ echo 3 | ./a.out
 How to create a cat? [method = 1,2,3]
 3: mixed approach
 c % legs() =           -4
 q % legs() =           -4

--------------------------------------------------
Side notes

* It is also OK to directly use make_cat() to generate a value of cat_t:
  e.g., allocate( q, source = make_cat() ) or q = make_cat().
  In this case, we do not need to overload cat_t() via interface.

* Another approach is to write an "initializer" as a type-bound procedure,
  and call it explicitly as q % init() (after allocating it via
  allocate( cat_t :: q )). If the type contains pointer components,
  this approach may be more straightforward by avoiding copy of
  components (which can be problematic for pointer components).