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
