gcc/testsuite/gfortran.dg/proc_decl_23.f90

   1 ! { dg-do compile }
   2 ! Test the fix for PR43227, in which the lines below would segfault.
   3 !
   4 ! Dominique d'Humieres <dominiq@lps.ens.fr>
   5 !
   6 function char1 (s) result(res)
   7   character, dimension(:), intent(in) :: s
   8   character(len=size(s)) :: res
   9   do i = 1, size(s)
  10     res(i:i) = s(i)
  11   end do
  12 end function char1
  13
  14 module m_string
  15
  16   procedure(string_to_char) :: char1                    ! segfault
  17   procedure(string_to_char), pointer :: char2           ! segfault
  18   type t_string
  19     procedure(string_to_char), pointer, nopass :: char3 ! segfault
  20   end type t_string
  21
  22 contains
  23
  24   function string_to_char (s) result(res)
  25     character, dimension(:), intent(in) :: s
  26     character(len=size(s)) :: res
  27     do i = 1, size(s)
  28       res(i:i) = s(i)
  29     end do
  30   end function string_to_char
  31
  32 end module m_string
  33
  34   use m_string
  35   type(t_string) :: t
  36   print *, string_to_char (["a","b","c"])
  37   char2 => string_to_char
  38   print *, char2 (["d","e","f"])
  39   t%char3 => string_to_char
  40   print *, t%char3 (["g","h","i"])
  41   print *, char1 (["j","k","l"])
  42 end
  43 ! { dg-final { cleanup-tree-dump "m_string" } }