My point is that in C++ the user doesn’t define the specific function unless it’s a specialisation, usually the compiler does the work.
I have taken your add_t example (texample.f90) and created a non-template version using generic interfaces (ntexample.f90) along with a c++ version (texample.cxx) In terms of lines of code I have
texample.f90 => 93
ntexample.f90 => 74
texample.cxx => 46
For me a large part of the reason to use templates is to obviate the need to write the boiler-plate code and thereby void copy/paste errors. So as in the c++ code I expect the compiler to write the ‘add’ code and for me to write the specialisations of check_result.
As a syntactic aside, perhaps instead of
type T; end type
you could have
typename T
! texample.f90
module template_add_m
implicit none
private
public :: add_t
requirement R(T, F)
type :: T; end type
function F(x, y) result(z)
type(T), intent(in) :: x, y
type(T) :: z
end function
end requirement
template add_t(T, F)
requires R(T, F)
private
public :: add_generic
contains
function add_generic(x, y) result(z)
type(T), intent(in) :: x, y
type(T) :: z
z = F(x, y)
end function
end template
! Old world
interface check_result
module procedure func_check_result_i
module procedure func_check_result_r
end interface check_result
contains
real function func_arg_real(x, y) result(z)
real, intent(in) :: x, y
z = x + y
end function
integer function func_arg_int(x, y) result(z)
integer, intent(in) :: x, y
z = x + y
end function
subroutine func_check_result_i(r, ref)
integer, intent(in) :: r, ref
write(*,advance='no',fmt='(a,i0)') "The result is ",r
call res(r == ref)
end subroutine func_check_result_i
subroutine func_check_result_r(r, ref)
real, intent(in) :: r, ref
write(*,advance='no',fmt='(a,g0.7)') "The result is ",r
call res(abs(r-ref) < 1.e-5)
end subroutine func_check_result_r
subroutine res(ok)
logical, intent(in) :: ok
if (ok) then
write(*,'(a)') ' => passed'
else
write(*,'(a)') ' => FAILED'
end if
end subroutine res
subroutine test_template()
! Issue: moving this into the block below causes a segmentation fault
instantiate add_t(real, func_arg_real), only: add_real => add_generic
block
real :: x, y, r
x = 5.1
y = 7.2
r = add_real(x, y)
call check_result(r, 12.3)
end block
instantiate add_t(integer, func_arg_int), only: add_integer => add_generic
block
integer :: a, b, r
a = 5
b = 9
r = add_integer(a, b)
call check_result(r, 14)
end block
end subroutine
end module
program template_add
use template_add_m
implicit none
call test_template()
end program template_add
! ntexample.f90
module template_add_m
implicit none
private
public :: add_t, test_template
interface add_t
module procedure func_arg_real
module procedure func_arg_int
end interface add_t
interface check_result
module procedure func_check_result_i
module procedure func_check_result_r
end interface check_result
contains
real function func_arg_real(x, y) result(z)
real, intent(in) :: x, y
z = x + y
end function
integer function func_arg_int(x, y) result(z)
integer, intent(in) :: x, y
z = x + y
end function
subroutine func_check_result_i(r, ref)
integer, intent(in) :: r, ref
write(*,advance='no',fmt='(a,i0)') "The result is ",r
call res(r == ref)
end subroutine func_check_result_i
subroutine func_check_result_r(r, ref)
real, intent(in) :: r, ref
write(*,advance='no',fmt='(a,g0.7)') "The result is ",r
call res(abs(r-ref) < 1.e-5)
end subroutine func_check_result_r
subroutine res(ok)
logical, intent(in) :: ok
if (ok) then
write(*,'(a)') ' => passed'
else
write(*,'(a)') ' => FAILED'
end if
end subroutine res
subroutine test_template()
block
real :: x, y, r
x = 5.1
y = 7.2
r = add_t(x,y)
call check_result(r,12.3)
end block
block
integer :: a,b, r
a = 5
b = 9
r = add_t(a, b)
call check_result(r, 14)
end block
end subroutine test_template
end module
program template_add
use template_add_m
implicit none
call test_template()
end program template_add
#include <iostream>
using namespace std;
namespace template_add_m {
template<typename T>
T add(T a, T b) {
return a + b;
}
template<typename T>
void check_result(T, T) {}
template<>
void check_result(int r, int ref) {
cout << "The result is " << r << " => ";
cout << (r != ref ? "FAILED" : "passed") << endl;
}
template<>
void check_result(double r, double ref) {
cout << "The result is " << r << " => ";
cout << ((abs(r-ref) > 1e-5) ? "FAILED" : "passed") << endl;
}
void test_template() {
{
double x, y, r;
x = 5.1;
y = 7.2;
r = add(x,y);
check_result(r, 12.3);
}
{
int a, b, r;
a = 5;
b = 9;
r = add(a, b);
check_result(r, 14);
}
}
}
int main(int, char**) {
template_add_m::test_template();
return 0;
}