1! { dg-do link }
2! PR 23675: Character function of module-variable length
3! PR 25716: Implicit kind conversions in in expressions written to *.mod-files.
4module cutils
5
6    implicit none
7    private
8
9    type t
10        integer :: k = 25
11        integer :: kk(3) = (/30, 40, 50 /)
12    end type t
13
14    integer :: m1 = 25, m2 = 25, m3 = 25, m4 = 25, m5 = 25
15    integer :: n5 = 3, n7 = 3, n9 = 3
16    integer(1) :: n1 = 3, n2 = 3, n3 = 3, n4 = 3, n6 = 3, n8 = 3
17    character(10) :: s = "abcdefghij"
18    integer :: x(4) = (/ 30, 40, 50, 60 /)
19    type(t), save :: tt1(5), tt2(5)
20
21    public :: IntToChar1, IntToChar2, IntToChar3, IntToChar4, IntToChar5, &
22                IntToChar6, IntToChar7, IntToChar8
23
24contains
25
26    pure integer function get_k(tt)
27        type(t), intent(in) :: tt
28
29        get_k = tt%k
30    end function get_k
31
32    function IntToChar1(integerValue) result(a)
33        integer, intent(in) :: integerValue
34        character(len=m1)  :: a
35
36        write(a, *) integerValue
37    end function IntToChar1
38
39    function IntToChar2(integerValue) result(a)
40        integer, intent(in) :: integerValue
41        character(len=m2+n1)  :: a
42
43        write(a, *) integerValue
44    end function IntToChar2
45
46    function IntToChar3(integerValue) result(a)
47        integer, intent(in) :: integerValue
48        character(len=iachar(s(n2:n3)))  :: a
49
50        write(a, *) integerValue
51    end function IntToChar3
52
53    function IntToChar4(integerValue) result(a)
54        integer, intent(in) :: integerValue
55        character(len=tt1(n4)%k)  :: a
56
57        write(a, *) integerValue
58    end function IntToChar4
59
60    function IntToChar5(integerValue) result(a)
61        integer, intent(in) :: integerValue
62        character(len=maxval((/m3, n5/)))  :: a
63
64        write(a, *) integerValue
65    end function IntToChar5
66
67    function IntToChar6(integerValue) result(a)
68        integer, intent(in) :: integerValue
69        character(len=x(n6))  :: a
70
71        write(a, *) integerValue
72    end function IntToChar6
73
74    function IntToChar7(integerValue) result(a)
75        integer, intent(in) :: integerValue
76        character(len=tt2(min(m4, n7, 2))%kk(n8))  :: a
77
78        write(a, *) integerValue
79    end function IntToChar7
80
81    function IntToChar8(integerValue) result(a)
82        integer, intent(in) :: integerValue
83        character(len=get_k(t(m5, (/31, n9, 53/))))  :: a
84
85        write(a, *) integerValue
86    end function IntToChar8
87
88end module cutils
89
90
91program test
92
93    use cutils
94
95    implicit none
96    character(25) :: str
97
98    str = IntToChar1(3)
99    print *, str
100    str = IntToChar2(3)
101    print *, str
102    str = IntToChar3(3)
103    print *, str
104    str = IntToChar4(3)
105    print *, str
106    str = IntToChar5(3)
107    print *, str
108    str = IntToChar6(3)
109    print *, str
110    str = IntToChar7(3)
111    print *, str
112    str = IntToChar8(3)
113    print *, str
114
115end program test
116