[Bug fortran/54788] ICE on pointer-array element assignment

slayoo at staszic dot waw.pl gcc-bugzilla@gcc.gnu.org
Wed Oct 3 10:45:00 GMT 2012


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=54788

--- Comment #4 from Sylwester Arabas <slayoo at staszic dot waw.pl> 2012-10-03 10:45:10 UTC ---
Thanks for your replies!

I've managed to get a vector of array pointers employing one more intermediate
derived type. The arrvec_t defined below has also some limited support for
negative indexing as in Python:



module arrvec_m
  implicit none

  type :: arr_t
    real, pointer :: a(:,:)
  end type

  type :: arrptr_t
    class(arr_t), pointer :: p
  end type

  type :: arrvec_t
    class(arrptr_t), pointer :: at(:)
    logical, pointer :: inited(:)
    contains
    procedure :: ctor => arrvec_ctor
    procedure :: init => arrvec_init
    procedure :: dtor => arrvec_dtor ! waiting for FINAL
  end type

  contains

  subroutine arrvec_ctor(this, n)
    class(arrvec_t) :: this
    integer, intent(in) :: n

    allocate(this%at(-n:n-1))
    allocate(this%inited(0:n-1))
    this%inited = .false.
  end subroutine

  subroutine arrvec_init(this, n, i_min, i_max, j_min, j_max)
    class(arrvec_t) :: this
    integer, intent(in) :: n, i_min, i_max, j_min, j_max

    allocate(this%at(n)%p)
    allocate(this%at(n)%p%a(i_min : i_max, j_min : j_max))
    this%inited(n) = .true.
    this%at(n - size(this%inited))%p => this%at(n)%p
  end subroutine

  subroutine arrvec_dtor(this)
    class(arrvec_t) :: this
    integer :: i

    do i = 0, size(this%inited) - 1
      if (this%inited(i)) then
        deallocate(this%at(i)%p%a)
        deallocate(this%at(i)%p)
      end if
    end do
    deallocate(this%at)
  end subroutine
end module



program test_arrvec
  use arrvec_m
  class(arrvec_t), pointer :: psi

  allocate(psi)
  call psi%ctor(2)
  call psi%init(0, 0, 3, 0, 4)

  print*, psi%at(0)%p%a
  print*, psi%at(0)%p%a(1,1)
  psi%at(0)%p%a(1,1) = 10
  print*, psi%at(0)%p%a(1,1)
  print*, psi%at(-2)%p%a(1,1)

  call psi%dtor
  deallocate(psi)
end



More information about the Gcc-bugs mailing list