1 ! Copyright 2019-2020 Free Software Foundation, Inc.
3 ! This program is free software; you can redistribute it and/or modify
4 ! it under the terms of the GNU General Public License as published by
5 ! the Free Software Foundation; either version 3 of the License, or
6 ! (at your option) any later version.
8 ! This program is distributed in the hope that it will be useful,
9 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
10 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 ! GNU General Public License for more details.
13 ! You should have received a copy of the GNU General Public License
14 ! along with this program. If not, see <http://www.gnu.org/licenses/> .
16 ! Source code for function-calls.exp.
18 subroutine no_arg_subroutine()
21 logical function no_arg()
30 logical function one_arg(x)
31 logical, intent(in) :: x
35 integer(kind=4) function one_arg_value(x)
36 integer(kind=4), value :: x
40 integer(kind=4) function several_arguments(a, b, c)
41 integer(kind=4), intent(in) :: a
42 integer(kind=4), intent(in) :: b
43 integer(kind=4), intent(in) :: c
44 several_arguments = a + b + c
47 integer(kind=4) function mix_of_scalar_arguments(a, b, c)
48 integer(kind=4), intent(in) :: a
49 logical(kind=4), intent(in) :: b
50 real(kind=8), intent(in) :: c
51 mix_of_scalar_arguments = a + floor(c)
53 mix_of_scalar_arguments=mix_of_scalar_arguments+1
57 real(kind=4) function real4_argument(a)
58 real(kind=4), intent(in) :: a
62 integer(kind=4) function return_constant()
66 character(40) function return_string()
67 return_string='returned in hidden first argument'
70 recursive function fibonacci(n) result(item)
71 integer(kind=4) :: item
72 integer(kind=4), intent(in) :: n
77 item = fibonacci(n-1) + fibonacci(n-2)
81 complex function complex_argument(a)
82 complex, intent(in) :: a
86 integer(kind=4) function array_function(a)
87 integer(kind=4), dimension(11) :: a
88 array_function = a(ubound(a, 1, 4))
91 integer(kind=4) function pointer_function(int_pointer)
92 integer, pointer :: int_pointer
93 pointer_function = int_pointer
96 integer(kind=4) function hidden_string_length(string)
97 character*(*) :: string
98 hidden_string_length = len(string)
101 integer(kind=4) function sum_some(a, b, c)
103 integer, optional :: c
106 sum_some = sum_some + c
110 module derived_types_and_module_calls
117 integer, allocatable :: d(:)
124 type(cart) function pass_cart(c)
128 integer(kind=4) function pass_cart_nd(c)
130 pass_cart_nd = ubound(c%d,1,4)
132 type(nested_cart_3d) function pass_nested_cart(c)
133 type(nested_cart_3d) :: c
136 type(cart) function build_cart(x,y)
143 program function_calls
144 use derived_types_and_module_calls
147 logical function no_arg()
149 logical function one_arg(x)
150 logical, intent(in) :: x
152 integer(kind=4) function pointer_function(int_pointer)
153 integer, pointer :: int_pointer
155 integer(kind=4) function several_arguments(a, b, c)
156 integer(kind=4), intent(in) :: a
157 integer(kind=4), intent(in) :: b
158 integer(kind=4), intent(in) :: c
160 complex function complex_argument(a)
161 complex, intent(in) :: a
163 real(kind=4) function real4_argument(a)
164 real(kind=4), intent(in) :: a
166 integer(kind=4) function return_constant()
168 character(40) function return_string()
170 integer(kind=4) function one_arg_value(x)
171 integer(kind=4), value :: x
173 integer(kind=4) function sum_some(a, b, c)
175 integer, optional :: c
177 integer(kind=4) function mix_of_scalar_arguments(a, b, c)
178 integer(kind=4), intent(in) :: a
179 logical(kind=4), intent(in) :: b
180 real(kind=8), intent(in) :: c
182 integer(kind=4) function array_function(a)
183 integer(kind=4), dimension(11) :: a
185 integer(kind=4) function hidden_string_length(string)
186 character*(*) :: string
189 logical :: untrue, no_arg_return
190 complex :: fft, fft_result
191 integer(kind=4), dimension (11) :: integer_array
192 real(kind=8) :: real8
193 real(kind=4) :: real4
194 integer, pointer :: int_pointer
195 integer, target :: pointee, several_arguments_return
196 integer(kind=4) :: integer_return
197 type(cart) :: c, cout
198 type(cart_nd) :: c_nd
199 type(nested_cart_3d) :: nested_c
200 character(40) :: returned_string, returned_string_debugger
204 fft = cmplx(2.1, 3.3)
207 int_pointer => pointee
217 ! Use everything so it is not elided by the compiler.
218 call no_arg_subroutine()
219 no_arg_return = no_arg() .AND. one_arg(.FALSE.)
220 several_arguments_return = several_arguments(1,2,3) + return_constant()
221 integer_return = array_function(integer_array)
222 integer_return = mix_of_scalar_arguments(2, untrue, real8)
223 real4 = real4_argument(3.4)
224 integer_return = pointer_function(int_pointer)
226 integer_return = pass_cart_nd(c_nd)
227 nested_c = pass_nested_cart(nested_c)
228 integer_return = hidden_string_length('string of implicit length')
229 call run(no_arg_subroutine)
230 integer_return = one_arg_value(10)
231 integer_return = sum_some(1,2,3)
232 returned_string = return_string()
233 cout = build_cart(4,5)
234 fft_result = complex_argument(fft)
236 print *, several_arguments_return
239 print *, integer_return
240 print *, returned_string_debugger
241 deallocate(c_nd%d) ! post_init