Polymorphic pointer to parent class not working

[esmaily__mahdi]

Consider the following class structure, which involves three separate modules:

!----------------------- in file a.f

      module parent_body_mod
      type :: face
         class(parent_body), pointer :: bPtr
      end type
      type, abstract :: parent_body
         integer i
         type(face) :: f
      end type
      end module parent_body_mod

!------------------------ in file b.f

      module body_mod
      use parent_body_mod

      type, extends(parent_body) :: body
      end type

      interface body
         procedure :: new_body
      end interface

      contains

      function new_body() result(b) 
      type(body), target :: b
      b%i = 123
      b%f%bPtr => b
      end function
      end module body_mod

!--------------------------- in file c.f

      module body_group_mod
      use body_mod
      type :: body_group
         type(body), allocatable :: b
      end type
      interface body_group
         procedure :: new_body_group
      end interface
      contains 
      function new_body_group() result(bg)
      type(body_group) :: bg

      allocate(bg%b)
      bg%b = body()

      end function
      end module body_group_mod

!------------------- The main program

      use body_group_mod

      type(body_group) :: my_bg

      my_bg = body_group()      

      print *, my_bg%b%f%bPtr%i

      end

!--------------------------------------

The expected output is 123, whereas the actual output is something random. The code is compiled using ifort version 18.0.1. Note that the same issue doesn't happen when using "body" class itself, i.e. the following works just fine:

type(body), allocatable :: my_b

allocate(my_b)

my_b = body()

print *, my_b%f%bPtr%i     ! This produces 123 as expected.

Any help is appreciated.

[FortranFan]

@esmaily, mahdi,

Others more familiar with the language standard may provide you with better guidance, but my hunch going mostly by mental notes is you need a defined assignment with your concrete implementation, body, to ensure a valid target for the component.  A finalizer, by the way, may be prudent for this type.  Also, you may need a SELECT TYPE construct to reference the polymorphic pointer component bPtr of an abstract declared type. 

!----------------------- in file a.f
module parent_body_mod
   type :: face
      class(parent_body), pointer :: bPtr => null()
   end type
   type, abstract :: parent_body
      integer i
      type(face) :: f
   end type
end module parent_body_mod

!------------------------ in file b.f
module body_mod
   use parent_body_mod, only : parent_body

   type, extends(parent_body) :: body
      private
   contains
      private
      final :: clean_body
      procedure, pass(this) :: assign_body
      generic, public :: assignment(=) => assign_body
   end type

   interface body
      procedure :: new_body
   end interface

contains

   function new_body() result(b)
      type(body), target :: b
      b%i = 123
      b%f%bPtr => b
   end function

   subroutine assign_body(this, b)
      class(body), intent(inout), target :: this
      type(body), intent(in) :: b
      this%i = b%i
      this%f%bPtr => this
   end subroutine

   elemental subroutine clean_body(this)
      type(body), intent(inout) :: this
      this%f%bPtr => null()
   end subroutine
   
end module body_mod

!--------------------------- in file c.f
module body_group_mod
   use body_mod, only : body
   type :: body_group
      type(body), allocatable :: b
   end type
   interface body_group
      procedure :: new_body_group
   end interface
contains
   function new_body_group() result(bg)
      type(body_group) :: bg

      allocate(bg%b)
      bg%b = body()

   end function
end module body_group_mod

!------------------- The main program
   use body_mod, only : body
   use body_group_mod, only : body_group

   type(body_group) :: my_bg

   my_bg = body_group()

   select type ( bPtr => my_bg%b%f%bPtr )
      type is ( body )
         print *, bPtr%i
      class default
   end select

end
!--------------------------------------