1! { dg-do compile }
2!
3! PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
4!
5! Original test case contributed by Hans-Werner Boschmann <boschmann@tp1.physik.uni-siegen.de>
6
7module m
8
9  implicit none
10
11  type :: t1
12   contains
13     procedure, nopass :: a => a1
14     procedure, nopass :: b => b1
15     procedure, nopass :: c => c1
16     procedure, nopass :: d => d1
17     procedure, nopass :: e => e1
18  end type
19
20  type, extends(t1) :: t2
21   contains
22     procedure, nopass :: a => a2  ! { dg-error "Character length mismatch in function result" }
23     procedure, nopass :: b => b2  ! { dg-error "Rank mismatch in function result" }
24     procedure, nopass :: c => c2  ! FIXME: dg-warning "Possible character length mismatch"
25     procedure, nopass :: d => d2  ! valid, check for commutativity (+,*)
26     procedure, nopass :: e => e2  ! { dg-error "Character length mismatch in function result" }
27  end type
28
29contains
30
31  function a1 ()
32    character(len=6) :: a1
33  end function
34
35  function a2 ()
36    character(len=7) :: a2
37  end function
38
39  function b1 ()
40    integer :: b1
41  end function
42
43  function b2 ()
44    integer, dimension(2) :: b2
45  end function
46
47  function c1 (x)
48    integer, intent(in) :: x
49    character(2*x) :: c1
50  end function
51
52  function c2 (x)
53    integer, intent(in) :: x
54    character(3*x) :: c2
55  end function
56
57  function d1 (y)
58    integer, intent(in) :: y
59    character(2*y+1) :: d1
60  end function
61
62  function d2 (y)
63    integer, intent(in) :: y
64    character(1+y*2) :: d2
65  end function
66
67  function e1 (z)
68    integer, intent(in) :: z
69    character(3) :: e1
70  end function
71
72  function e2 (z)
73    integer, intent(in) :: z
74    character(z) :: e2
75  end function
76
77end module m
78
79
80
81
82module w1
83
84 implicit none
85
86 integer :: n = 1
87
88 type :: tt1
89 contains
90   procedure, nopass :: aa => aa1
91 end type
92
93contains
94
95 function aa1 (m)
96  integer, intent(in) :: m
97  character(n+m) :: aa1
98 end function
99
100end module w1
101
102
103module w2
104
105 use w1, only : tt1
106
107 implicit none
108
109 integer :: n = 2
110
111 type, extends(tt1) :: tt2
112 contains
113   procedure, nopass :: aa => aa2  ! FIXME: dg-warning "Possible character length mismatch"
114 end type
115
116contains
117
118 function aa2 (m)
119  integer, intent(in) :: m
120  character(n+m) :: aa2
121 end function
122
123end module w2
124