[Bug fortran/99602] [11 regression] runtime error: pointer actual argument not associated

[pault at gcc dot gnu.org via Gcc-bugs]

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

--- Comment #30 from Paul Thomas <pault at gcc dot gnu.org> ---
Created attachment 50442
  --> https://gcc.gnu.org/bugzilla/attachment.cgi?id=50442&action=edit
Patch that "fixes" all versions of the problem.. so far :-)

Hi Juergen,

I think that this one does the job... it is even correct and regtests OK;-)

I found that the gdb session was a miserable afair that didn't help at all
because of the change in dwarf versions. I would up reducing the testcase to
what you will find below. Please excuse my mutilation of Whizard!

The chunk of whizard that you provided throws up all sorts of memories. In the
1970's I used to go up to Caltech every Wednesday for Feynman and Gell-mann
seminars. I was around for the earliest days of partons and the realisation
that quarks might even be real.

Paul

module model_data
  type :: model_data_t
     type(modelpar_real_t), dimension(:), pointer :: par_real => null ()
   contains
     procedure :: get_par_data_ptr => model_data_get_par_data_ptr_name
     procedure :: set => field_data_set
  end type model_data_t

  type :: modelpar_real_t
     character (4) :: name
     real(4) :: value
  end type modelpar_real_t

  type(modelpar_real_t), target :: names(2) = [modelpar_real_t("foo ", 1), &
                                               modelpar_real_t("bar ", 2)]

contains

  function model_data_get_par_data_ptr_name (model, name) result (ptr)
    class(model_data_t), intent(in) :: model
    character (*), intent(in) :: name
    class(modelpar_real_t), pointer :: ptr
    integer :: i
    ptr => null ()
    do i = 1, size (model%par_real)
       if (model%par_real(i)%name == name) ptr => model%par_real(i)
    end do
  end function model_data_get_par_data_ptr_name

  subroutine field_data_set (this, ptr)
    class(model_data_t), intent(inout) :: this
    class(modelpar_real_t), intent(in), pointer :: ptr
    if (associated (ptr)) then
      print *, "'ptr%value' = ", ptr%value
    else
      print *, "'ptr' not associated in 'field_data_set'"
    end if
  end subroutine

end module model_data

  use model_data
  class(model_data_t), allocatable :: model
  class(modelpar_real_t), pointer :: name_ptr

  allocate (model_data_t :: model)
  model%par_real => names

!  name_ptr => model%get_par_data_ptr ("bar ")
!  call field_data_set (model, name_ptr)
!  call field_data_set (model, model%get_par_data_ptr ("bar "))
  call model%set (model%get_par_data_ptr ("bar "))
  call model%set (model%get_par_data_ptr ("tea "))
end