OSDN Git Service

66cf5fff736efa6307db9b356666f42fdd464ab6
[pf3gnuchains/gcc-fork.git] / 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" } }
44 ! { dg-final { cleanup-modules "m_string" } }