Re: Incorrect behavior when assigning pointer

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

Hi Tobias:

> Andrew Benson wrote:
> > I've been tracking down a particularly elusive bug, and I think it's
> > probably a compiler error.
> > 
> >    recursive function bhGet(self,instance,autoCreate)
> > 
> > [...]
> > 
> >      select type (self)
> >      class is (tn)
> >      
> >         if
> > 
> > (allocated(self%cBh).and.autoCreate.and.same_type_as(self%cBh(1),BhClass))
> > deallocate(self%cBh)
> 
> Cray ftn complains here that "An argument in the DEALLOCATE statement is
> a disassociated pointer, an unallocated array, or a pointer not
> allocated as a pointer."
> 
> And indeed if I comment that line, it works with both Crayftn and
> gfortran. (I am not claiming that I understand the issue as "cBh" should
> be allocatable â and the issue should only occur with pointers.) Maybe
> one should have a closer look at this issue and think about it a bit.

That's very intersting. I also don't understand the issue reported by Cray 
ftn. "cBh" is not a pointer, so the only relevant condition in the Cray ftn 
error message is "an unallocated array", but the preceding if statement is 
checking that the array is allocated.

With some modifications to the code, I can create the same problem without the 
DEALLOCATE line being included (code appended below). Could you check what 
Cray ftn says in this case?

> And ifort points out that "self" lacks the "target" attribute at:
> 
> subroutine tnInit(self,index)
> implicit none
> class (tn ), intent(inout) :: self
> ...
> type is (tn)
> self%cBh(1)%hostNode => self
> 
> I think ifort is right in this case, which implies that gfortran has a
> accepts-invalid bug. As is (w/ target added), the program crashes after
> printing the last "2 = " line (ifort also prints "2 = 1"). With the
> deallocate line commented, it crashes with a segfault.

Thanks - I've corrected this in my code. For me, gfortran accepts both with 
and without the TARGET added, but in both cases still results in the wrong 
output.

I also checked that valgrind doesn't report any issues, for what it's worth.

With this updated test case I find that ifort v11.1 compiles and runs 
successfully (i.e. produces the expected output). I don't have a copy of Cray 
ftn to try unfortunately.

Thanks,
Andrew.

--

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
  end type tn

  type(ncBhStd) :: defaultBhC

contains

  subroutine tnInit(self,index)
    implicit none
    class (tn ), intent(inout), target :: self
    integer, intent(in ) :: index
    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=defaultBhC)
    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,2
       targetNode%cBh(i)%hostNode => targetNode
    end do
    return
  end subroutine Node_C_Bh_Move

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

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

 function bhGet1(self,instance)
    implicit none
    class (ncBh), pointer :: bhGet1
    class (tn ), intent(inout), target :: self
    integer , intent(in ) :: instance

    select type (self)
    class is (tn)
       bhGet1 => self%cBh(instance)
    end select
    return
  end function bhGet1

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.)
  n => bh%hostNode
  write (0,*) 1,'=',n%indexValue
  bh => b%bh(autoCreate=.true.)
  n => bh%hostNode
  write (0,*) 2,'=',n%indexValue

  call a%bhMove(b)

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

end program test


-- 

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

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