gcc/testsuite/gfortran.dg/proc_ptr_comp_32.f90

   1 ! { dg-do compile }
   2 !
   3 ! PR 48095: [OOP] Invalid assignment to procedure pointer component not rejected
   4 !
   5 ! Contributed by Arjen Markus <arjen.markus895@gmail.com>
   6
   7 module m
   8
   9   implicit none
  10
  11   type :: rectangle
  12     procedure(get_area), pointer :: get_special_area
  13   end type rectangle
  14
  15   abstract interface
  16     real function get_area( this )
  17       import                       :: rectangle
  18       class(rectangle), intent(in) :: this
  19     end function get_area
  20   end interface
  21
  22 contains
  23
  24   real function get_my_area( this )
  25     type(rectangle), intent(in) :: this
  26     get_my_area = 3.0
  27   end function get_my_area
  28
  29 end module
  30
  31
  32 use m
  33 type(rectangle) :: rect
  34 rect%get_special_area => get_my_area  ! { dg-error "Interface mismatch in procedure pointer assignment" }
  35 end
  36
  37 ! { dg-final { cleanup-modules "m" } }