[Bug fortran/46339] [4.3/4.4/4.5/4.6 Regression] ICE (segfault) in gfc_trans_pointer_assignment

["jvdelisle at gcc dot gnu.org" <gcc-bugzilla@gcc.gnu.org>]

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

--- Comment #15 from Jerry DeLisle <jvdelisle at gcc dot gnu.org> 2010-11-16 06:42:08 UTC ---
With a slight modification to the patch in Comment #10, gfortran now gives:

@@ -1041,7 +1041,7 @@
 tree
 gfc_get_symbol_decl (gfc_symbol * sym)
 {
-  tree decl;
+  tree decl = NULL;
   tree length = NULL_TREE;
   tree attributes;
   int byref;


$ ./a.out 
 *******************
 myA      =           1 a           2 b           3 c           4 d
 -------------------
 Inside test_sub:
   sorb%i%j =           1           2           3           4
   ipn%i%j  =           1           2           3           4
   ipn      =           1           2           3           4
 Inside main:
        ptr =           1          97           2          98
    myA%i%j =           1           2           3           4
 Inside test_sub2:
   sorb%i%j =           1           2           3           4
  local_ptr =           1           2           3           4

This is much closer. Just need to get the returned pointer right.

Test case is:

module test
  implicit none
  type b
    integer :: j
    character :: c
  end type b
  type a
    type(b), dimension(4) :: i
  end type a
contains
  subroutine test_sub(sorb,ipn)
    type(a), intent(in), target :: sorb
    integer, dimension(:), pointer :: ipn
    ipn=>sorb%i%j
    print *, "Inside test_sub:"
    print *, "  sorb%i%j =", sorb%i%j
    print *, "  ipn%i%j  =", ipn(:)
    print *, "  ipn      =", ipn
  end subroutine test_sub
  subroutine test_sub2(sorb)
    type(a), intent(in), target :: sorb
    integer, dimension(:), pointer :: local_ptr
    local_ptr=>sorb%i%j
    print *, "Inside test_sub2:"
    print *, "  sorb%i%j =", sorb%i%j
    print *, " local_ptr =", local_ptr
    if (any(local_ptr /= (/ 1,2,3,4 /))) call abort()
  end subroutine test_sub2
end module test

program main
  use test
  implicit none
  type(a), target :: myA
  integer, dimension(:), pointer :: ptr
  myA%i(1:4)%j = (/ 1, 2, 3, 4 /)
  myA%i(1:4)%c = (/ 'a', 'b', 'c', 'd' /)
  print *, "*******************"
  print *, "myA      =", myA
  print *, "-------------------"
  call test_sub(myA,ptr)
  print *, "Inside main:"
  print *, "       ptr =", ptr
  print *, "   myA%i%j =", myA%i%j
  !if (any(ptr /= (/ 1,2,3,4 /))) call abort()
  call test_sub2(myA)
end program main