! { dg-do run } ! { dg-options "-fcheck=pointer" } ! ! Test the fix for PR99602 in which the runtime error, ! "Proc-pointer actual argument 'model' is not associated" was triggered ! by the NULL result from model%get_par_data_ptr ("tea ") ! ! Contributed by Juergen Reuter ! 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.0), & modelpar_real_t("bar ", 2.0)] integer :: return_value = 0 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 return_value = int (ptr%value) else return_value = -1 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 call model%set (model%get_par_data_ptr ("bar ")) if (return_value .ne. 2) stop 1 call model%set (model%get_par_data_ptr ("tea ")) ! Triggered runtime error if (return_value .ne. -1) stop 2 end