Incorrect behavior when assigning pointer

[Andrew Benson <abenson at obs dot carnegiescience dot edu>]

Hi,

I've been tracking down a particularly elusive bug, and I think it's probably 
a compiler error. I've created a reduced test case, but it's not as reduced as 
I would like (i.e. it's still quite complicated). Here's the code:

module G_Nodes

  type :: nc
    type(tn), pointer :: hostNode
   contains
  end type nc

  type, extends(nc) :: ncBh
   contains
  end type ncBh

  type, public, extends(ncBh) :: ncBhStd
    double precision :: massSeedData
   contains
  end type ncBhStd

  type, public :: tn
    integer :: indexValue
    class (ncBh), allocatable, dimension(:) :: cBh
   contains
     procedure :: init      => tnInit
     procedure :: bhMove   => Node_C_Bh_Move
     procedure :: bh       => bhGet
     procedure :: bhCreate => bhCreateLinked
  end type tn

  type(ncBhStd) :: defaultBhC

  type(ncBh) :: BhClass

contains

  subroutine tnInit(self,index)
    implicit none
    class (tn ), intent(inout) :: self
    integer, intent(in ) :: index

    allocate(self%cBh(1))
    select type (self)
    type is (tn)
       self%cBh(1)%hostNode => self
    end select
    self%indexValue=index
    return
  end subroutine tnInit

  subroutine Node_C_Bh_Move(self,targetNode)
    implicit none
    class (tn ), intent(inout) :: self
    type (tn ), intent(inout) , target :: targetNode
    integer :: i
    class (ncBh), allocatable, dimension(:) :: instancesTemporary

    allocate(instancesTemporary(2),source=self%cBh(1))
    select type (from => targetNode%cBh)
    type is (ncBhStd)
       select type (to => instancesTemporary)
       type is (ncBhStd)
          to(1:1)=from
       end select
    end select
    select type (from => self%cBh)
    type is (ncBhStd)
       select type (to => instancesTemporary)
       type is (ncBhStd)
          to(2:2)=from
       end select
    end select
    call Move_Alloc(instancesTemporary,targetNode%cBh)
    do i=1,size(targetNode%cBh)
       targetNode%cBh(i)%hostNode => targetNode
    end do
    return
  end subroutine Node_C_Bh_Move

  recursive function bhGet(self,instance,autoCreate)
    implicit none
    class (ncBh), pointer :: bhGet
    class (tn ), intent(inout), target :: self
    integer , intent(in ) :: instance
    logical , intent(in ) :: autoCreate

    select type (self)
    class is (tn)
       if 
(allocated(self%cBh).and.autoCreate.and.same_type_as(self%cBh(1),BhClass)) 
deallocate(self%cBh)
       if (.not.allocated(self%cBh).and.autoCreate) call self%bhCreate()
       bhGet => self%cBh(instance)
    end select
    return
  end function bhGet

  subroutine bhCreateLinked(self)
    implicit none
    class (tn ), intent(inout), target :: self

    allocate(self%cBh(1),source=defaultBhC)
    select type (self)
    type is (tn)
        self%cBh(1)%hostNode => self
    end select
    return
  end subroutine bhCreateLinked

end module G_Nodes

program test
  use G_Nodes
  implicit none
  type(tn) :: a,b
  type(tn), pointer :: n
  class(ncBh), pointer :: bh
 
  call a%init(index=1)
  call b%init(index=2)

  bh => a%bh(autoCreate=.true.,instance=1)
  n => bh%hostNode
  write (0,*) 1,'=',n%indexValue
  bh => b%bh(autoCreate=.true.,instance=1)
  n => bh%hostNode
  write (0,*) 2,'=',n%indexValue

  call a%bhMove(b)

  bh => b%bh(autoCreate=.false.,instance=1)
  n => bh%hostNode
  write (0,*) 2,'=',n%indexValue
  bh => b%bh(autoCreate=.false.,instance=2)
  n => bh%hostNode
  write (0,*) 2,'=',n%indexValue

end program test


When I compile and run this (using a recent checkout of trunk; r192549) I get:

$ gfortran -v
Using built-in specs.
COLLECT_GCC=gfortran
COLLECT_LTO_WRAPPER=/home/abenson/Galacticus/Tools/libexec/gcc/x86_64-unknown-
linux-gnu/4.8.0/lto-wrapper
Target: x86_64-unknown-linux-gnu
Configured with: ../gcc-trunk/configure --
prefix=/home/abenson/Galacticus/Tools --enable-languages=c,c++,fortran --
disable-multilib --with-gmp=/home/abenson/Galacticus/Tools
Thread model: posix
gcc version 4.8.0 20121017 (experimental) (GCC) 
$ gfortran test.F90 -o test.exe -ffree-line-length-none -frecursive
$ test.exe
           1 =           1
           2 =           2
           2 =           2
           2 =           1

but the expected output is:

$ test.exe
           1 =           1
           2 =           2
           2 =           2
           2 =           2

To explain what this code is doing:

1) It initializes two objects of type "tn" ("a" and "b"). The initialization 
allocates a polymorphic array of type "ncBh" in the "tn" objects and assigns 
an index (1 for "a" and 2 for "b") to them. Additionally, a pointer "hostNode" 
is set in the "ncBh" objects which points back to the containing "tn" object.

2) It checks that the initialization of the pointers in the "ncBh" objects 
worked by using that pointer to get the containing "tn" object and the writing 
out its index. This gives the first two lines of output. (To the left of the 
"=" is the expected value and to the right is the actual value.)

3) It then calls a function which moves the "ncBh" object from "a" to "b", 
such that the "ncBh" object in "b" is now a 2-element array. As part of doing 
this, the code reassigns the "hostNode" pointer to point to the new containing 
"tn" object.

4) Finally, it checks that the "hostNode" pointers are still consistent (i.e. 
point to the "tn" object which contains each "ncBh" object). This is the 
second pair of output lines. It appears that the pointer for the "ncBh" object 
originally in "a" does not get updated after being moved to "b" (as shown by 
the inconsistent values in the final line of output).

Interestingly, if I remove the "double precision :: massSeedData" line from 
the ncBhStd type definution then the code works as expected.

Apologies for the lack of a more compact test case!

-Andrew.

-- 

* Andrew Benson: http://users.obs.carnegiescience.edu/abenson/contact.html

* Galacticus: http://sites.google.com/site/galacticusmodel