https://gcc.gnu.org/bugzilla/show_bug.cgi?id=57117

--- Comment #5 from Paul Thomas <pault at gcc dot gnu.org> ---
Created attachment 36609
  --> https://gcc.gnu.org/bugzilla/attachment.cgi?id=36609&action=edit
Draft patch for the PR

The two TODOs should be noted. These must be fixed before submission. However,
this patch does regtest without regressions.

The following version of the testcase runs correctly.

Cheers

Paul

  implicit none
  integer :: j, k
  type :: ti
   real(8) :: r
  end type
  type, extends (ti) :: ri
    integer :: i
  end type
  class(ti), allocatable :: x(:,:), z(:)

  allocate (z, source = [(ti (real (j)), j = 1, 9)])
  allocate(x(3,3), source=reshape(z, (/ 3,3 /)))
  call foo
  deallocate (z, x)

  allocate (z, source = [(ri (real (j), j), j = 1, 9)])
  allocate(x(3,3), source=reshape(z, (/ 3,3 /)))
  call foo
  deallocate (z, x)

contains
  subroutine foo
    select type (x)
      type is (ti)
        print *, "ti"
        print *, x%r
      type is (ri)
        print *, "ri"
        print *, x%r
        print *, x%i
      class default
        call abort
    end select
  end subroutine
end

Reply via email to