gcc/testsuite/gfortran.dg/generic_30.f90

   1 ! { dg-do compile }
   2 !
   3 ! PR fortran/66929
   4 ! Generic procedures as actual argument used to lead to
   5 ! a NULL pointer dereference in gfc_get_proc_ifc_for_expr
   6 ! because the generic symbol was used as procedure symbol,
   7 ! instead of the specific one.
   8
   9 module iso_varying_string
  10   type, public :: varying_string
  11      character(LEN=1), dimension(:), allocatable :: chars
  12   end type varying_string
  13   interface operator(/=)
  14      module procedure op_ne_VS_CH
  15   end interface operator (/=)
  16   interface trim
  17      module procedure trim_
  18   end interface
  19 contains
  20   elemental function op_ne_VS_CH (string_a, string_b) result (op_ne)
  21     type(varying_string), intent(in) :: string_a
  22     character(LEN=*), intent(in)     :: string_b
  23     logical                          :: op_ne
  24     op_ne = .true.
  25   end function op_ne_VS_CH
  26   elemental function trim_ (string) result (trim_string)
  27     type(varying_string), intent(in) :: string
  28     type(varying_string)             :: trim_string
  29     trim_string = varying_string(["t", "r", "i", "m", "m", "e", "d"])
  30   end function trim_
  31 end module iso_varying_string
  32 module syntax_rules
  33   use iso_varying_string, string_t => varying_string
  34 contains
  35   subroutine set_rule_type_and_key
  36     type(string_t) :: key
  37     if (trim (key) /= "") then
  38       print *, "non-empty"
  39     end if
  40   end subroutine set_rule_type_and_key
  41 end module syntax_rules