http://gcc.gnu.org/bugzilla/show_bug.cgi?id=55763
--- Comment #9 from Tobias Burnus <burnus at gcc dot gnu.org> 2012-12-28
12:26:15 UTC ---
I think all issues have been fixed, except for the sub-pointer issue, i.e. last
example of comment 0 - see also comment 6.
The following modified version of the last example of comment 0 also uses
sub-pointers, however, it compiles but produces the wrong result. I think one
should quickly check whether that's a bug in CLASS(*) or just a problem with
subpointers. - If the former, we should fix it, if the latter, we can regard
this as WONTFIX (before the new array descriptor) - and close this PR.
With gfortran, it prints:
0.00000000 1.00000000 1.10000002
-1.00000000
while with crayftn it prints:
0., 0.200000003, 0.400000006
-1.
program change_field_type
use, intrinsic :: iso_c_binding
implicit none
REAL(kind=c_float), POINTER :: vector_comp(:)
TYPE, BIND(C) :: scalar_vector
REAL(kind=c_float) :: scalar
REAL(kind=c_float) :: vec(3)
END TYPE
TYPE, BIND(C) :: scalar_vector_matrix
REAL(kind=c_float) :: scalar
REAL(kind=c_float) :: vec(3)
REAL(kind=c_float) :: mat(3,3)
END TYPE
CLASS(*), ALLOCATABLE, TARGET :: one_d_field(:)
real, pointer :: v1(:)
allocate(one_d_field(3), &
source = (/ scalar_vector( 1.0, (/ -1.0, 0.0, 1.0 /) ), &
scalar_vector( 1.1, (/ -1.2, 0.2, 0.9 /) ), &
scalar_vector( 1.2, (/ -1.4, 0.4, 0.8 /) ) /) )
call extract_vec(one_d_field, 1, 2)
print *, vector_comp
deallocate(one_d_field) ! v1 becomes undefined
allocate(one_d_field(1), &
source = (/ scalar_vector_matrix( 1.0, (/ -1.0, 0.0, 1.0 /), &
reshape( (/ 1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0 /), &
(/3, 3/) ) ) /) )
call extract_vec(one_d_field, 2, 1)
print *, vector_comp
deallocate(one_d_field) ! v1 becomes undefined
contains
subroutine extract_vec(field, tag, ic)
use, intrinsic :: iso_c_binding
CLASS(*), TARGET :: field(:)
INTEGER(kind=c_int), value :: tag, ic
type(scalar_vector), pointer :: sv(:)
type(scalar_vector_matrix), pointer :: svm(:)
select type (field)
type is (real(c_float))
vector_comp => field
class default
select case (tag)
case (1)
sv => field
vector_comp => sv(:)%vec(ic)
case (2)
svm => field
vector_comp => svm(:)%vec(ic)
end select
end select
end subroutine
end program
