! { dg-do run }
!
! Test the fix for PR55763 comment 9 as part of the overall fix for PR34640.
!
! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
!
  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)
    if (any (abs (vector_comp - [0.0,0.2,0.4]) .gt. 1e-4)) STOP 1
    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)
    if (abs (vector_comp(1) + 1.0) > 1e-4) STOP 2
    call extract_vec(one_d_field, 2, 3)
    if (abs (vector_comp(1) - 1.0) > 1e-4) STOP 3
    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