- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Hello,
i got a problem with object members of arrays beeing passed to a subroutine. In the following example everything works fine a long as the dummy argument arr_arg of foo is defined as type. But as soon as it is defined as class it breaks. Dependent on compiler options (/Od) access violations are detected or (/O2) unpredictable behavior occours. This can cause difficult to find errors later on.
The code-example gives 4 cases: Type/Class and Variant 1/2
Surprisingly variant 2 works for the type definition ( and for the class with /O2), where i thought it should not as the brackets produce a copy of the objects(?)
Greetings
Wolf
program MAIN
implicit none
! Inner Type
type T_B
integer, allocatable :: arr_real(:,:)
integer :: dummy_1b
end type
! Outer Type
type T_A
type(T_B) :: arr_T_B
integer :: dummy_1a
real, allocatable :: dummy_3a(:)
end type
type(T_A) :: bar(1:2)
integer, pointer :: ptr_outer(:)
allocate(bar(1)%arr_T_B%arr_real(10,2))
allocate(bar(2)%arr_T_B%arr_real(10,2))
bar(1)%arr_T_B%arr_real(:,1) = [10:19]+1000
bar(1)%arr_T_B%arr_real(:,2) = [10:19]+2000
bar(2)%arr_T_B%arr_real(:,1) = [20:29]+1000
bar(2)%arr_T_B%arr_real(:,2) = [20:29]+2000
write(*,'("0x",Z8.8)')LOC(bar(1)%arr_T_B)
write(*,'("0x",Z8.8)')LOC(bar(2)%arr_T_B)
write(*,*)LOC(bar(2)%arr_T_B) - LOC(bar(1)%arr_T_B) !< Always 92
write(*,*)
! Variant 1
call foo(bar(1:2)%arr_T_B, ptr_outer)
! Variant 2
! call foo([bar(1)%arr_T_B,bar(2)%arr_T_B], ptr_outer)
write(*,*)"Extern"
write(*,'(*(I6))')ptr_outer
bar(2)%arr_T_B%arr_real(:,2) = [1:10]
write(*,*)
write(*,*)"Pointer modified"
write(*,'(*(I6))')ptr_outer ! Surprisingly Variant 2 with "Type" works
contains
subroutine foo(arr_arg, ptr_inner)
! type(T_B), target, intent(in ) :: arr_arg(1:2) !< Works
class(T_B), target, intent(in ) :: arr_arg(1:2) !< Does not work
integer, pointer, intent( out) :: ptr_inner(:)
! New(V1&V2) address for type -> Old(V1) | New(V2) address for class
write(*,'("0x",Z8.8)')LOC(arr_arg(1))
! New(V1&V2) address for type(+92) -> Old(V1) | New(V2) address for class(+52)
write(*,'("0x",Z8.8)')LOC(arr_arg(2))
write(*,*)LOC(arr_arg(2)) - LOC(arr_arg(1)) !< Always 52;
write(*,*)"is_contiguous?", is_contiguous(arr_arg) ! Seems to be correct
write(*,*)"Intern"
ptr_inner => arr_arg(2)%arr_real(:,2)
write(*,'(*(I6))')ptr_inner !< Printed results are wrong
write(*,'(*(I6))')arr_arg(2)%arr_real(:,2) !< Error is thrown here
end subroutine
end program
Link Copied
0 Replies
Reply
Topic Options
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page