[Bug fortran/79230] [7 Regression] Run time error: malloc on valid code

juergen.reuter at desy dot de gcc-bugzilla@gcc.gnu.org
Fri Jan 27 21:26:00 GMT 2017


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


More information about the Gcc-bugs mailing list