Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.

Downcast function result without copy

Ferdinand_T_
New Contributor II
1,289 Views

Problem: A subprogram 'make_child' returns a variable of type 'child' which is an extension of the 'parent' type. 'make_child' itself gets the 'child' from a generic factory, which produces the 'child', but declares it as 'parent' type. (Note: this is not about human genetic engineering, it's a Fortran question...)

Question 1 (Fortran Standard): How can 'make_child' downcast the 'parent'-type into the result declared as 'child', without creating a copy (large data!) ?

What I tried so far:

  1. Sourced allocation within a select-type environment -> no solution (must copy the data & leave the select-type-env. in order to return from 'make_child')
  2. move_alloc works in ifort 14.0.3 and ifort 15, but is not standard-conforming (same kind of 'from' and 'to').

Question 2 (Intel): In case I use move_alloc nevertheless (if there is no better answer to Question 1), will this non-conforming code compile and work correctly on all future version with ifort?

Code: Here, make_child is a subroutine with intent(out) dummy as result, and not a function. Reason: allocation in a function result cannot be moved to lhs without copying (as Steve pointed out to me in https://software.intel.com/en-us/forums/topic/495399)

Compiles with ifort 14.0.3 and 15.0.1.

[fortran]

program test

    type :: parent_type

    end type

    type, extends(parent_type) :: child_type

    end type

    class(child_type), allocatable :: new_child

 

    call make_child(new_child)

contains

    subroutine make_child(child)

        class(child_type), allocatable :: child

        class(parent_type), allocatable :: tmp

 

        ! Create child with help from generic factory

        ! e.g. in real code: call factory(tmp, make="child")

        allocate(child_type :: tmp)

 

        ! Move allocation in 'tmp' into result 'child'

        ! Note: not standard-conforming!

        call move_alloc(from=tmp, to=child)

    end subroutine

end program

[/fortran]

 

PS: I really would like to know a standard-conforming way using allocatables (not pointers) here.

 

Best regards

Ferdinand

 

0 Kudos
20 Replies
Steven_L_Intel1
Employee
1,272 Views

You are correct that this is nonconforming:

TO shall be type compatible (4.3.1.3) with FROM ....

A polymorphic entity that is not an unlimited polymorphic entity is type compatible with entities of the same declared type or any of its extensions.

TO here is "child" whose declared type is child_type. FROM is tmp whose declared type is parent_type. The rule would require that tmp be the same declared type as child (child_type) or an extension of child_type, which clearly it is not. It is always important to remember that type compatibility is not bidirectional: A can be type compatible with B with B not being type compatible with A. Note that the rule does NOT require that the FROM and TO be the same type (despite gfortran 4.8's saying that they must be.)

I can't think of a way to get what you want, but maybe others can.

As for the question as to whether ifort will continue to allow your program, I'm sorry to say that it will not as I will be creating a bug report for this. (Edit: in fact there was already a report of this, not yet fixed. DPD200361056)

0 Kudos
Ferdinand_T_
New Contributor II
1,272 Views

Thank you for the clarification and for ruling out the non-conforming way (in fact I hoped that this was not an option, because if it was, it would be a very ugly one...)!

As a side-note about that 'same type' - misconception, even the Intel-docs for move_alloc state, that (https://software.intel.com/en-us/node/526469):

to

(Output) Must have the same type and type parameters as from and have the same rank; it must be allocatable.


I would appreciate a solution because I so far liked modern Fortran's concept of allocatables as a robust replacement for pointers (when no aliasing is required). However, for me it seems that they are not entirely useful yet (or I am trying to do the wrong things with them).

0 Kudos
Steven_L_Intel1
Employee
1,272 Views

I wonder where that "same type" text came from - MOVE_ALLOC was new in F2003 but the F2003 standard says "type compatible". I will let our writers know - thanks.

I suggest that pointers are indeed what you want here.

0 Kudos
FortranFan
Honored Contributor III
1,272 Views

Ferdinand T. wrote:

 ..

I would appreciate a solution because I so far liked modern Fortran's concept of allocatables as a robust replacement for pointers (when no aliasing is required). However, for me it seems that they are not entirely useful yet (or I am trying to do the wrong things with them).

Good luck with your quest, it'll be great if you can report back on this forum if you find a solution elsewhere.

By the way, there is no suggestion anywhere that allocatables in Fortran can replace pointers under all circumstances, is there?

0 Kudos
jimdempseyatthecove
Honored Contributor III
1,272 Views

>>By the way, there is no suggestion anywhere that allocatables in Fortran can replace pointers under all circumstances, is there?

Consider a counter rhetorical question?

How might one represent a doubly linked list using allocatables?

Sure, one could allocate an array of nodes, then use the index as a substitute for next and back. But this becomes problematic when the number of nodes is indeterminate.

Jim Dempsey

0 Kudos
jimdempseyatthecove
Honored Contributor III
1,271 Views

Well, not using a trivial example, rather use a list of 100 nodes where a new node is inserted at node 50.

Conceivably this could be performed using recursive functions that constitute an expression containing copies of subsections of the list. Technically it might be doable but practically not.

Jim Dempsey

0 Kudos
jimdempseyatthecove
Honored Contributor III
1,272 Views

Back on Ferdinand's question.

I am not too versed in the oop features of Fortran, considering Steve's response, what do you think about flipping your data structures:

program test
    type :: child_type
    end type
    type, extends(child_type) :: parent_type
    end type
...

Jim Dempsey

0 Kudos
FortranFan
Honored Contributor III
1,272 Views

jimdempseyatthecove wrote:

..

How might one represent a doubly linked list using allocatables?

..

Yes, that is one example that would require pointers for any practical use case even if the Fortran 2008 feature of "allocatable components of recursive type" was available in the compiler.

Back to the point, If anyone can figure how to downcast without using pointers and without copying data and with standard Fortran as indicated by OP, it'll be quite impressive indeed.

Seems to me what the OP essentially wants is the current Intel implementation of MOVE_ALLOC (for which Steve is planning to submit a bug report) to become standard, probably not gonna happen.

I'd think a redo of the OP's object-oriented design, where "factory method" is bound to the type and extended for each child - or something along these lines - might be a better way to proceed.

0 Kudos
Ferdinand_T_
New Contributor II
1,272 Views

jimdempseyatthecove wrote:

Consider a counter rhetorical question?

How might one represent a doubly linked list using allocatables?

Ok, a doubly linked list requires aliasing, so there is no way to use allocatables.

But my point of view is that allocatables were introduced to offer a better choice over pointers where no aliasing is required.

@ Jim Dempsey: Upcasting does indeed work, but in my actual code I can't simply swap the inheritance.

0 Kudos
Steven_L_Intel1
Employee
1,272 Views

Allocatables are where you simply want dynamic allocation. Pointers have other properties that can't be replaced by allocatables, and aliasing is rarely part of it. If you need pointer assignment, you need pointers.

0 Kudos
FortranFan
Honored Contributor III
1,272 Views

Ferdinand T. wrote:

..

But my point of view is that allocatables were introduced to offer a better choice over pointers where no aliasing is required.

..

Why do you think downcasting, a process considered to be avoided by many OOP luminaries, wouldn't involve aliasing?  Most likely, languages that do support it make use of it, even if it is hidden to the coder.

0 Kudos
Ferdinand_T_
New Contributor II
1,272 Views

The reason why? Because...

a) Intel's move_alloc did allow it (technically), and

b) my task was to single out products of a specific dynamic type created by the factory and separate them into a container. Since this didn't require  multiple (pointer-) references to these products, I thought allocatables were the best choice (with regard to robustness and optimization of the code).

Well, the answer is probably to restructure my code, as FortranFan suggested. As a non-professional programmer, I lack experience in how to set up a 'good' object-oriented design. Your comments and Fortran's rejection of my coding will hopefully push me into a better direction... so, thank you for your answers!

Out of curiosity: Why does the selector in a select type statement loose it's allocatable attribute?

PS: Here's a code that achieves what I want, in case anybody is interested.

module m
    implicit none

    ! Class hirarchy
    type :: parent_type
    end type
    type :: child_a_type
    end type
    type :: child_b_type
    end type

    ! Wrappers
    type, abstract :: wrapper_type
    end type
    type, extends(wrapper_type) :: child_a_wrapper_type
        type(child_a_type), allocatable :: child_a    
    end type
    type, extends(wrapper_type) :: child_b_wrapper_type
        type(child_b_type), allocatable :: child_b    
    end type

contains

    ! Factory that wraps products into abstract wrapper
    subroutine factory(wrapped_product, make)
        implicit none
        class(wrapper_type), allocatable, intent(out) :: wrapped_product
        character(len=*), intent(in) :: make
        
        ! Wrappers for different products
        type(child_a_wrapper_type), allocatable :: child_a_wrapper
        type(child_b_wrapper_type), allocatable :: child_b_wrapper

        ! Product is determined by 'make', but in real code
        ! the choice can be made by the factory internally
        select case (make)
        case ("child_a")
            allocate(child_a_wrapper)
            allocate(child_a_wrapper%child_a)
            call move_alloc(child_a_wrapper, wrapped_product)
        case ("child_b")
            allocate(child_b_wrapper)
            allocate(child_b_wrapper%child_b)
            call move_alloc(child_b_wrapper, wrapped_product)
        case default
            stop "unknown product requested"
        end select
    end subroutine

end module

program test
    use m
    implicit none

    class(child_b_type), allocatable :: child_b
    class(wrapper_type), allocatable :: wrapped_product

    ! Create wrapped polymorphic product in factory
    call factory(wrapped_product, make="child_b")

    ! Unwrap product and extract the allocation
    select type (wrapped_product)
    type is (child_b_wrapper_type)
        ! Can move allocation of wrapped product, because it is only
        ! a component of the (here no more allocatable) selector
        call move_alloc(from=wrapped_product%child_b, to=child_b)
    end select
end program

 

0 Kudos
Steven_L_Intel1
Employee
1,271 Views

That our compiler allows this is a bug, not intentional. In no way can this be considered support of what is a bad idea.

0 Kudos
FortranFan
Honored Contributor III
1,272 Views

Ferdinand T. wrote:

The reason why? Because...

a) Intel's move_alloc did allow it (technically), and

b) my task was to single out products of a specific dynamic type created by the factory and separate them into a container. Since this didn't require  multiple (pointer-) references to these products, I thought allocatables were the best choice (with regard to robustness and optimization of the code).

Well, the answer is probably to restructure my code, as FortranFan suggested. As a non-professional programmer, I lack experience in how to set up a 'good' object-oriented design. Your comments and Fortran's rejection of my coding will hopefully push me into a better direction... so, thank you for your answers!

 ..

Your example code doesn't give sufficient details re: your needs.  Since your original post indicates the parent type may hold "large data" which precludes copying and therefore constructors, can you not do something along the following lines?

module m

   implicit none

   private

   type, public :: parent_t
      integer :: i
   contains
      procedure, pass(this), public :: init => init_parent_t
   end type parent_t

   type, extends(parent_t), public :: child_a_t
      integer :: j
   contains
      procedure, pass(this), public :: init => init_child_a_t
   end type child_a_t

   type, extends(parent_t), public :: child_b_t
      integer :: k
   contains
      procedure, pass(this), public :: init => init_child_b_t
   end type child_b_t

contains

   subroutine init_parent_t(this)

      class(parent_t), intent(inout) :: this

      this%i = 1

      return

   end subroutine init_parent_t

   subroutine init_child_a_t(this)

      class(child_a_t), intent(inout) :: this

      call this%parent_t%init()
      this%j = 2

      return

   end subroutine init_child_a_t

   subroutine init_child_b_t(this)

      class(child_b_t), intent(inout) :: this

      call this%parent_t%init()
      this%k = 3

      return

   end subroutine init_child_b_t

end module m
program p

   use m, only : parent_t, child_a_t, child_b_t

   implicit none

   class(parent_t), allocatable :: foo

   call make("parent")
   call make("child_a")
   call make("child_b")

   stop

contains

   subroutine make(make_type)

      character(len=*), intent(in) :: make_type

      select case ( make_type )
         case ( "parent" )
            allocate( parent_t :: foo)

         case ( "child_a")
            allocate( child_a_t :: foo)

         case ( "child_b" )
            allocate( child_b_t :: foo)

      end select

      call foo%init()
      call print_t()
      deallocate(foo)

   end subroutine make

   subroutine print_t()

      select type ( foo )
         type is ( parent_t )
            print *, " parent_t%i = ", foo%i
         type is ( child_a_t )
            print *, " child_a_t%i = ", foo%i
            print *, " child_a_t%j = ", foo%j
         type is ( child_b_t )
            print *, " child_b_t%i = ", foo%i
            print *, " child_b_t%j = ", foo%k
         class default
      end select

   end subroutine print_t

end program
  parent_t%i =            1
  child_a_t%i =            1
  child_a_t%j =            2
  child_b_t%i =            1
  child_b_t%j =            3

Process returned 0 (0x0)   execution time : 0.012 s
Press any key to continue.

 

0 Kudos
Ferdinand_T_
New Contributor II
1,271 Views

Hmmm... so you initialize the objects with a type-bound initializer subroutine (as you suggested earlier). This prevents copying while initializing the (possibly very large) object. (In fact, this is how my code initializes large objects as well). Then, in the make - factory you decide which object to create and initialize them without any problems. Now, as I understand, the trick of your code is to never store the make'd objects in a polymorphic variable, but to keep them separated (in global scope). Of course then there is no downcasting needed and everything works fine!

As a workaround this is indeed a solution for me. However, in general I must say I don't think this will result in very elegant code, because in a more real-world example, the make-factory could not write into a fixed global scope, so there must be intent(out) arguments for every possible return type (see appended code-snipped). Since it is not clear which dynamic type make will create (in actual code, the decision is hidden), one has either to find out which of these possible return types is now allocated - or make has an other intent(out) flag to indicate the created type. But wouldn't that be a strange approach to mimic polymorphism, which additionally lacks essential features of Fortran's mechanism such as inheritance (what happens if a child_c is added in future) etc.?

Of course I don't expect you to help me with the design of my code as I reduced everything into a simple example where much information is lacking; e.g. make is used to produce many objects (number unknown) which all have to be processed afterwards, and so on.

For now I will switch to pointers, as Steve suggested. If allocatables were mandatory I would either try your suggestion, or the proposal I made in #13 (even though this requires wrappers for each type extension) as workarounds. Finally, a redesign would actually be the best solution, I guess.

Thank you,
Ferdinand

 

[fortran]

program

    type(parent), allocatable :: parent_outcome

    type(child_a), allocatable :: child_a_outcome

    type(child_b), allocatable :: child_b_outcome

    character(len=:), allocatable :: maked_type

    ! Make bypasses polymorphism by requesting dummy's for all possible return types

    call make(parent_outcome, child_a_outcome. child_b_outcome, maked_type)

    ! Find out which type of object make actually produced

    select case(maked_type)

    case("parent")

    case("child_a")

        ! Store child_a and parent in some container A

    case("child_b")

        ! Store child_b separately in some container B

    end select

end program

[/fortran]

 

 

0 Kudos
Cardin_P_
Beginner
1,272 Views

Como solução esta é realmente uma solução para mim. No entanto, em geral, eu devo dizer que eu não acho que isso irá resultar em um código muito elegante, porque em um exemplo mais real do mundo, o faz-de-fábrica não poderia escrever em um escopo global fixa, por isso deve haver intenção (sai) argumentos para cada possível tipo de retorno (ver cortou code-anexas). Uma vez que não está claro qual tipo de dinâmica make irá criar (no código atual, a decisão está escondido), tem-se tanto para descobrir quais os possíveis tipos de retorno agora afectados - ou fazer tem uma outra intenção (fora) flag para indicar o tipo criado. Mas isso não seria uma abordagem estranha para imitar polimorfismo, que, adicionalmente, carece de recursos essenciais do mecanismo de Fortran, como herança (o que acontece se um child_c é adicionado no futuro)

 

a minha ideia é que no codigo global tem que ser mais ou menos isso aqui: 

01 program
02     type(parent), allocatable :: parent_outcome
03     type(child_a), allocatable :: child_a_outcome
04     type(child_b), allocatable :: child_b_outcome
05     character(len=:), allocatable :: maked_type
06     ! Make bypasses polymorphism by requesting dummy's for all possible return types
07     call make(parent_outcome, child_a_outcome. child_b_outcome, maked_type)
08     ! Find out which type of object make actually produced
09     select case(maked_type)
10     case("parent")
11     case("child_a")
12         ! Store child_a and parent in some container A
13     case("child_b")
14         ! Store child_b separately in some container B
15     end select
16 end program
0 Kudos
Ferdinand_T_
New Contributor II
1,272 Views

Ferdinand T. wrote:
Your comments and Fortran's rejection of my coding will hopefully push me into a better direction... so, thank you for your answers!

I should clarify that I wanted to thank you for the answers you had already given - I am not expecting you to help me with my code-design (even if I could surely learn a lot from you, and I am impressed that you want to help me; for now you helped me a lot already understanding the mechanics of Fortran!)

 

0 Kudos
FortranFan
Honored Contributor III
1,272 Views

Ferdinand T. wrote:

... However, in general I must say I don't think this will result in very elegant code, because in a more real-world example, the make-factory could not write into a fixed global scope, so there must be intent(out) arguments for every possible return type (see appended code-snipped). Since it is not clear which dynamic type make will create (in actual code, the decision is hidden), one has either to find out which of these possible return types is now allocated - or make has an other intent(out) flag to indicate the created type. But wouldn't that be a strange approach to mimic polymorphism, which additionally lacks essential features of Fortran's mechanism such as inheritance (what happens if a child_c is added in future) etc.?

..

Appreciate your kind words.  Simply to clarify what I suggested and not trying to influence your code design, please note I did not imply any global scope; the global variable was simply a convenient way to show how a sample execution.  One is only limited by one's imagination and one's requirements, that's why I brought up your needs; that's the most critical aspect of OOP design.  Once a class hierarchy of parent and children are established, one may use them in a variety of ways, usually without any global variables (I personally avoid anything in global scope).  An example could be a wrapper class as you have mentioned a couple of times.  There are so many possibilities.

module m

   implicit none

   private

   type, public :: parent_t
      integer :: i
   contains
      procedure, pass(this), public :: init => init_parent_t
      procedure, pass(this), public :: print_t => print_parent_t
   end type parent_t

   type, extends(parent_t), public :: child_a_t
      integer :: j
   contains
      procedure, pass(this), public :: init => init_child_a_t
      procedure, pass(this), public :: print_t => print_child_a_t
   end type child_a_t

   type, extends(parent_t), public :: child_b_t
      integer :: k
   contains
      procedure, pass(this), public :: init => init_child_b_t
      procedure, pass(this), public :: print_t => print_child_b_t
   end type child_b_t

contains

   subroutine init_parent_t(this)

      class(parent_t), intent(inout) :: this

      this%i = 1

      return

   end subroutine init_parent_t

   subroutine init_child_a_t(this)

      class(child_a_t), intent(inout) :: this

      call this%parent_t%init()
      this%j = 2

      return

   end subroutine init_child_a_t

   subroutine init_child_b_t(this)

      class(child_b_t), intent(inout) :: this

      call this%parent_t%init()
      this%k = 3

      return

   end subroutine init_child_b_t

   subroutine print_parent_t(this)

      class(parent_t), intent(in) :: this

      print *, "parent_t%i = ", this%i

      return

   end subroutine print_parent_t

   subroutine print_child_a_t(this)

      class(child_a_t), intent(in) :: this

      print *, "child_a_t%i = ", this%i
      print *, "child_a_t%j = ", this%j

      return

   end subroutine print_child_a_t

   subroutine print_child_b_t(this)

      class(child_b_t), intent(in) :: this

      print *, "child_b_t%i = ", this%i
      print *, "child_b_t%k = ", this%k

      return

   end subroutine print_child_b_t

end module m
module f

   use m, only : parent_t, child_a_t, child_b_t

   implicit none

   type, public :: factory_t
      class(parent_t), allocatable :: d
   contains
      private
      procedure, pass(this), public :: print_d => print_factory_t
      procedure, pass(this), public :: make_d => make_factory_t
   end type factory_t

contains

   subroutine make_factory_t(this, make_type)

      class(factory_t), intent(inout) :: this
      character(len=*), intent(in)    :: make_type

      if (allocated(this%d)) deallocate(this%d)

      select case ( make_type )
         case ( "parent" )
            allocate( parent_t :: this%d)

         case ( "child_a")
            allocate( child_a_t :: this%d)

         case ( "child_b" )
            allocate( child_b_t :: this%d)

      end select

      call this%d%init()

   end subroutine make_factory_t

   subroutine print_factory_t(this)

      class(factory_t), intent(in) :: this

      call this%d%print_t()

   end subroutine print_factory_t

end module f
program p

   use f, only : factory_t

   implicit none

   type(factory_t) :: foo

   !..
   call foo%make_d("parent")
   call foo%print_d()

   !..
   call foo%make_d("child_a")
   call foo%print_d()

   !..
   call foo%make_d("child_b")
   call foo%print_d()

   stop

end program
 parent_t%i =            1
 child_a_t%i =            1
 child_a_t%j =            2
 child_b_t%i =            1
 child_b_t%k =            3

Press any key to continue.

 

0 Kudos
FortranFan
Honored Contributor III
1,272 Views

To elaborate on the possibilities I mentioned in Quote #19, here is another variation that you should find close to your original post.  Which style one prefers is mostly a matter of needs, but also of taste I suppose.

With this, I sign off this thread as I've more than overstayed my welcome.

module m

   implicit none

   private

   type, public :: parent_t
      integer :: i
   contains
      procedure, pass(this), public :: init => init_parent_t
      procedure, pass(this), public :: print_t => print_parent_t
   end type parent_t

   type, extends(parent_t), public :: child_a_t
      integer :: j
   contains
      procedure, pass(this), public :: init => init_child_a_t
      procedure, pass(this), public :: print_t => print_child_a_t
   end type child_a_t

   type, extends(parent_t), public :: child_b_t
      integer :: k
   contains
      procedure, pass(this), public :: init => init_child_b_t
      procedure, pass(this), public :: print_t => print_child_b_t
   end type child_b_t

contains

   subroutine init_parent_t(this)

      class(parent_t), intent(inout) :: this

      this%i = 1

      return

   end subroutine init_parent_t

   subroutine init_child_a_t(this)

      class(child_a_t), intent(inout) :: this

      call this%parent_t%init()
      this%j = 2

      return

   end subroutine init_child_a_t

   subroutine init_child_b_t(this)

      class(child_b_t), intent(inout) :: this

      call this%parent_t%init()
      this%k = 3

      return

   end subroutine init_child_b_t

   subroutine print_parent_t(this)

      class(parent_t), intent(in) :: this

      print *, "parent_t%i = ", this%i

      return

   end subroutine print_parent_t

   subroutine print_child_a_t(this)

      class(child_a_t), intent(in) :: this

      print *, "child_a_t%i = ", this%i
      print *, "child_a_t%j = ", this%j

      return

   end subroutine print_child_a_t

   subroutine print_child_b_t(this)

      class(child_b_t), intent(in) :: this

      print *, "child_b_t%i = ", this%i
      print *, "child_b_t%k = ", this%k

      return

   end subroutine print_child_b_t

end module m
module f

   use m, only : parent_t, child_a_t, child_b_t

   implicit none

   type, public :: factory_t
      character(len=:), allocatable :: make_type
      type(parent_t), allocatable  :: d
      type(child_a_t), allocatable :: ca
      type(child_b_t), allocatable :: cb
   contains
      private
      procedure, pass(this), public :: make_d => make_factory_t
   end type factory_t

   interface make
      module procedure make_parent_a
      module procedure make_child_a
      module procedure make_child_b
   end interface

contains

   subroutine make_factory_t(this, make_type)

      class(factory_t), intent(inout) :: this
      character(len=*), intent(in)    :: make_type

      this%make_type = make_type

      select case ( make_type )
         case ( "parent" )

            if (allocated(this%d)) deallocate(this%d)
            allocate( parent_t :: this%d)
            call this%d%init()

         case ( "child_a")

            if (allocated(this%ca)) deallocate(this%ca)
            allocate( child_a_t :: this%ca)
            call this%ca%init()

         case ( "child_b" )

            if (allocated(this%cb)) deallocate(this%cb)
            allocate( child_b_t :: this%cb)
            call this%cb%init()

      end select

   end subroutine make_factory_t

   subroutine make_parent_a(parent, make_type)

      class(parent_t), allocatable, intent(out) :: parent
      character(len=*), intent(in)              :: make_type

      !.. Local variables
      type(factory_t), allocatable :: tmp

      if (make_type == "parent") then
         allocate(tmp)
         call tmp%make_d(make_type)

         ! Move allocation in 'tmp' into result
         call move_alloc(from=tmp%d, to=parent)
      else
         !.. error
      end if

      deallocate(tmp)

   end subroutine make_parent_a

   subroutine make_child_a(child)

      class(child_a_t), allocatable, intent(out) :: child

      !.. Local variables
      type(factory_t), allocatable :: tmp

      allocate(tmp)
      call tmp%make_d("child_a")

      ! Move allocation in 'tmp' into result
      call move_alloc(from=tmp%ca, to=child)

      deallocate(tmp)

   end subroutine make_child_a

   subroutine make_child_b(child)

      class(child_b_t), allocatable, intent(out) :: child

      !.. Local variables
      type(factory_t), allocatable :: tmp

      allocate(tmp)
      call tmp%make_d("child_b")

      ! Move allocation in 'tmp' into result
      call move_alloc(from=tmp%cb, to=child)

      deallocate(tmp)

   end subroutine make_child_b

end module f
program p

   use m, only : parent_t, child_a_t, child_b_t
   use f, only : factory_t, make

   class(parent_t), allocatable :: d
   class(child_a_t), allocatable :: ca
   class(child_a_t), allocatable :: cb

   call make(d, "parent")
   call d%print_t()

   call make(ca)
   call ca%print_t()

   call make(cb)
   call cb%print_t()

end program
 parent_t%i =            1
 child_a_t%i =            1
 child_a_t%j =            2
 child_a_t%i =            1
 child_a_t%j =            2

Press any key to continue.

 

0 Kudos
Steven_L_Intel1
Employee
1,135 Views

The bugs reported here should be fixed in version 16.

0 Kudos
Reply