1! Copyright 2020 Free Software Foundation, Inc. 2! 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 2 of the License, or 6! (at your option) any later version. 7! 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. 12! 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/>. 15 16module type_module 17 use, intrinsic :: iso_c_binding, only: c_int, c_float, c_double 18 type, bind(C) :: MyType 19 real(c_float) :: a 20 real(c_float) :: b 21 end type MyType 22end module type_module 23 24program mixed_stack_main 25 implicit none 26 27 ! Set up some locals. 28 29 ! Call a Fortran function. 30 call mixed_func_1a 31 32 write(*,*) "All done" 33end program mixed_stack_main 34 35subroutine breakpt () 36 implicit none 37 write(*,*) "Hello World" ! Break here. 38end subroutine breakpt 39 40subroutine mixed_func_1a() 41 use type_module 42 implicit none 43 44 TYPE(MyType) :: obj 45 complex(kind=4) :: d 46 47 obj%a = 1.5 48 obj%b = 2.5 49 d = cmplx (4.0, 5.0) 50 51 ! Call a C function. 52 call mixed_func_1b (1, 2.0, 3D0, d, "abcdef", obj) 53end subroutine mixed_func_1a 54 55! This subroutine is called from the Fortran code. 56subroutine mixed_func_1b(a, b, c, d, e, g) 57 use type_module 58 implicit none 59 60 integer :: a 61 real(kind=4) :: b 62 real(kind=8) :: c 63 complex(kind=4) :: d 64 character(len=*) :: e 65 character(len=:), allocatable :: f 66 TYPE(MyType) :: g 67 68 interface 69 subroutine mixed_func_1c (a, b, c, d, f, g) bind(C) 70 use, intrinsic :: iso_c_binding, only: c_int, c_float, c_double 71 use, intrinsic :: iso_c_binding, only: c_float_complex, c_char 72 use type_module 73 implicit none 74 integer(c_int), value, intent(in) :: a 75 real(c_float), value, intent(in) :: b 76 real(c_double), value, intent(in) :: c 77 complex(c_float_complex), value, intent(in) :: d 78 character(c_char), intent(in) :: f(*) 79 TYPE(MyType) :: g 80 end subroutine mixed_func_1c 81 end interface 82 83 ! Create a copy of the string with a NULL terminator on the end. 84 f = e//char(0) 85 86 ! Call a C function. 87 call mixed_func_1c (a, b, c, d, f, g) 88end subroutine mixed_func_1b 89 90! This subroutine is called from the C code. 91subroutine mixed_func_1d(a, b, c, d, str) 92 use, intrinsic :: iso_c_binding, only: c_int, c_float, c_double 93 use, intrinsic :: iso_c_binding, only: c_float_complex 94 implicit none 95 integer(c_int) :: a 96 real(c_float) :: b 97 real(c_double) :: c 98 complex(c_float_complex) :: d 99 character(len=*) :: str 100 101 interface 102 subroutine mixed_func_1e () bind(C) 103 implicit none 104 end subroutine mixed_func_1e 105 end interface 106 107 write(*,*) a, b, c, d, str 108 109 ! Call a C++ function (via an extern "C" wrapper). 110 call mixed_func_1e 111end subroutine mixed_func_1d 112 113! This is called from C++ code. 114subroutine mixed_func_1h () 115 call breakpt 116end subroutine mixed_func_1h 117