https://gcc.gnu.org/bugzilla/show_bug.cgi?id=79230
--- Comment #5 from Jürgen Reuter <juergen.reuter at desy dot de> ---
Here is the promised reduced test case, 80 lines, and I do believe that this is
most likely causing the issues of all our 250 failing tests (hopefully).
Attached and plain:
module module1
implicit none
private
public :: data_t
public :: t1_t
public :: t2_t
type :: string_t
private
character(LEN=1), dimension(:), allocatable :: chars
end type string_t
type, abstract :: data_t
type(string_t) :: name
end type data_t
type, extends (data_t) :: real_t
real :: value
end type real_t
type :: t1_t
character, dimension(:), allocatable :: name
real, pointer :: width_val => null ()
class(data_t), pointer :: width_data => null ()
contains
procedure :: set => t1_set
end type t1_t
type :: t2_t
type(real_t), dimension(:), pointer :: par_real => null ()
type(t1_t), dimension(:), allocatable :: field
contains
procedure :: get_par_real_ptr => t2_get_par_real_ptr_index
end type t2_t
contains
subroutine t1_set (prt, width_data)
class(t1_t), intent(inout) :: prt
class(data_t), intent(in), pointer :: width_data
real, pointer :: ptr
prt%width_data => width_data
if (associated (width_data)) then
select type (width_data)
type is (real_t)
prt%width_val => width_data%value
class default
prt%width_val => null ()
end select
end if
end subroutine t1_set
function t2_get_par_real_ptr_index (model, i) result (ptr)
class(t2_t), intent(inout) :: model
integer, intent(in) :: i
class(data_t), pointer :: ptr
ptr => model%par_real(i)
end function t2_get_par_real_ptr_index
end module module1
!!!!!
program main_ut
use module1
implicit none
call evaluator_1 ()
contains
subroutine evaluator_1 ()
type(t2_t), target :: model
type(t1_t), pointer :: field
allocate (model%par_real (1))
allocate (model%field (1))
field => model%field(1)
call field%set (width_data=model%get_par_real_ptr (7))
deallocate (model%par_real)
end subroutine evaluator_1
end program main_ut
