best to use struct with C_BOOL mismatch to show problem

in case of segfault (e.g. windows oneapi) need this well-known technique for WILL_FAIL

Author: scivision

src/bool/bad_bool.f90

@@ -1,31 +1,43 @@
 module bad_bool
 
 use, intrinsic :: iso_c_binding, only : C_INT
+use, intrinsic :: iso_fortran_env, only : error_unit
 
 implicit none
 
+integer, parameter :: lk = 8
+
+type, bind(C) :: bool_args
+	logical(8) :: value
+	integer(C_INT) :: dummy
+end type
+
 contains
 
-logical function logical_not(L, dummy) bind(C)
-logical, intent(in), value :: L
-integer(C_INT), intent(in) :: dummy
+logical function logical_not(args) bind(C)
+type(bool_args), intent(in), value :: args
 
-logical_not = .not. L
+logical_not = .not. args%value
 
-print '(/, a, l1, a, l1)', "logical_not(", L, "): ", logical_not
+print '(/, a, l1, a, l1)', "logical_not(", args%value, "): ", logical_not
 
 print '(a16,2x,a,2x,a8,2x,a8)', "storage_size()", "bits", "hex(in)", "hex(out)"
-print '(a16,2x,i3,2x,z8,2x,z8)', "C_BOOL: ", storage_size(L), L, logical_not
+print '(a16,2x,i3,2x,z8,2x,z8)', "C_BOOL: ", storage_size(args%value), args%value, logical_not
 
-if (dummy /= 42_C_INT) error stop "dummy argument should be 42"
+if (args%dummy /= 42_C_INT) then
+    write(error_unit, '(a,i0,a)') "bool_passthru passed dummy argument ", args%dummy, " but expected 42"
+    error stop
+end if
 
 end function logical_not
 
-logical function bool_passthru(L, dummy) bind(C)
-logical, intent(in), value :: L
-integer(C_INT), intent(in) :: dummy
-if (dummy /= 42_C_INT) error stop "dummy argument should be 42"
-bool_passthru = L
+logical function bool_passthru(args) bind(C)
+type(bool_args), intent(in), value :: args
+if (args%dummy /= 42_C_INT) then
+    write(error_unit, '(a,i0,a)') "bool_passthru passed dummy argument ", args%dummy, " but expected 42"
+    error stop
+end if
+bool_passthru = args%value
 end function bool_passthru
 
 

src/bool/logbool.c

@@ -7,26 +7,26 @@
 
 #include "my_bool.h"
 
-bool logical_not(bool a, int* dummy)
+bool logical_not(bool_args args)
 {
-  printf("C boolean sizeof(%d) = %zu\n", a, sizeof(a));
-  if (*dummy != 42) {
-    fprintf(stderr, "ERROR: dummy argument != 42, but %d\n", *dummy);
+  printf("C boolean sizeof(%d) = %zu\n", args.value, sizeof(args.value));
+  if (args.dummy != 42) {
+    fprintf(stderr, "ERROR: dummy argument != 42, but %d\n", args.dummy);
     exit(EXIT_FAILURE);
   }
 
-  return !a;
+  return !args.value;
 }
 
-bool bool_passthru(bool a, int* dummy)
+bool bool_passthru(bool_args args)
 {
-  printf("C boolean sizeof(%d) = %zu\n", a, sizeof(a));
-  if (*dummy != 42) {
-    fprintf(stderr, "ERROR: dummy argument != 42, but %d\n", *dummy);
+  printf("C boolean sizeof(%d) = %zu\n", args.value, sizeof(args.value));
+  if (args.dummy != 42) {
+    fprintf(stderr, "ERROR: dummy argument != 42, but %d\n", args.dummy);
     exit(EXIT_FAILURE);
   }
 
-  return a;
+  return args.value;
 }
 
 bool bool_true(){ return true; }

src/bool/logbool.cpp

@@ -3,26 +3,26 @@
 
 #include "my_bool.h"
 
-bool logical_not(const bool a, int* dummy)
+bool logical_not(const bool_args args)
 {
-  std::cout << "C++ boolean sizeof(" << a << ") = " << sizeof(a) << "\n";
-  if (*dummy != 42) {
-    std::cerr << "ERROR: dummy argument != 42, but " << *dummy << "\n";
+  std::cout << "C++ boolean sizeof(" << args.value << ") = " << sizeof(args.value) << "\n";
+  if (args.dummy != 42) {
+    std::cerr << "ERROR: dummy argument != 42, but " << args.dummy << "\n";
     std::exit(EXIT_FAILURE);
   }
 
-  return !a;
+  return !args.value;
 }
 
-bool bool_passthru(const bool a, int* dummy)
+bool bool_passthru(const bool_args args)
 {
-  std::cout << "C++ boolean sizeof(" << a << ") = " << sizeof(a) << "\n";
-  if (*dummy != 42) {
-    std::cerr << "ERROR: dummy argument != 42, but " << *dummy << "\n";
+  std::cout << "C++ boolean sizeof(" << args.value << ") = " << sizeof(args.value) << "\n";
+  if (args.dummy != 42) {
+    std::cerr << "ERROR: dummy argument != 42, but " << args.dummy << "\n";
     std::exit(EXIT_FAILURE);
   }
 
-  return a;
+  return args.value;
 }
 
 bool bool_true(){ return true; }

src/bool/logbool.f90

@@ -1,34 +1,42 @@
 module logbool
 
-use, intrinsic :: iso_c_binding, only : C_BOOL, C_INT
+use, intrinsic :: iso_c_binding
+use, intrinsic :: iso_fortran_env
 
 implicit none
 
-contains
+type, bind(C) :: bool_args
+	logical(C_BOOL) :: value
+	integer(C_INT) :: dummy
+end type
 
-logical(c_bool) function logical_not(L, dummy) bind(C)
+contains
 
-logical(c_bool), intent(in), value :: L
-integer(c_int), intent(in) :: dummy
+logical(C_BOOL) function logical_not(args) bind(C)
+type(bool_args), intent(in), value :: args
 
-logical_not = .not. L
+logical_not = .not. args%value
 
-print '(/, a, l1, a, l1)', "logical_not(", L, "): ", logical_not
+print '(/, a, l1, a, l1)', "logical_not(", args%value, "): ", logical_not
 
 print '(a16,2x,a,2x,a8,2x,a8)', "storage_size()", "bits", "hex(in)", "hex(out)"
-print '(a16,2x,i3,2x,z8,2x,z8)', "C_BOOL: ", storage_size(L), L, logical_not
+print '(a16,2x,i3,2x,z8,2x,z8)', "C_BOOL: ", storage_size(args%value), args%value, logical_not
 
-if (dummy /= 42_c_int) error stop "dummy argument should be 42"
-! print '(a)', "logical_not passed dummy argument correctly"
+if (args%dummy /= 42_C_INT) then
+    write(error_unit, '(a,i0,a)') "bool_passthru passed dummy argument ", args%dummy, " but expected 42"
+    error stop
+end if
 
 end function logical_not
 
 
-logical(C_BOOL) function bool_passthru(L, dummy) bind(C)
-logical(C_BOOL), intent(in), value :: L
-integer(C_INT), intent(in) :: dummy
-if (dummy /= 42_C_INT) error stop "dummy argument should be 42"
-bool_passthru = L
+logical(C_BOOL) function bool_passthru(args) bind(C)
+type(bool_args), intent(in), value :: args
+if (args%dummy /= 42_C_INT) then
+    write(error_unit, '(a,i0,a)') "bool_passthru passed dummy argument ", args%dummy, " but expected 42"
+    error stop
+end if
+bool_passthru = args%value
 end function bool_passthru
 
 
@@ -40,4 +48,4 @@ logical(C_BOOL) function bool_false() bind(C)
 bool_false = .false._C_BOOL
 end function
 
-end module logbool
+end module

src/bool/my_bool.h

@@ -2,8 +2,13 @@
 extern "C" {
 #endif
 
-bool logical_not(const bool, int*);
-bool bool_passthru(const bool, int*);
+typedef struct bool_args {
+	bool value;
+	int dummy;
+} bool_args;
+
+bool logical_not(bool_args);
+bool bool_passthru(bool_args);
 
 bool bool_true();
 bool bool_false();

test/bool/CMakeLists.txt

@@ -39,17 +39,18 @@ add_test(NAME Cpp_C_bool COMMAND cxx_c_bool)
 add_executable(fortran_c_bad_bool bad_interface.f90)
 target_link_libraries(fortran_c_bad_bool PRIVATE bool_c)
 set_property(TARGET fortran_c_bad_bool PROPERTY LINKER_LANGUAGE Fortran)
-add_test(NAME Fortran_C_bad_bool COMMAND fortran_c_bad_bool)
+add_test(NAME Fortran_C_bad_bool COMMAND ${CMAKE_COMMAND} -E env $<TARGET_FILE:fortran_c_bad_bool>)
 
 add_library(bad_bool_fortran OBJECT ${PROJECT_SOURCE_DIR}/src/bool/bad_bool.f90)
 target_include_directories(bad_bool_fortran INTERFACE ${PROJECT_SOURCE_DIR}/src/bool)
 
 add_executable(c_fortran_bad_bool main.c)
 target_link_libraries(c_fortran_bad_bool PRIVATE bad_bool_fortran)
-add_test(NAME C_Fortran_bad_bool COMMAND c_fortran_bad_bool)
+add_test(NAME C_Fortran_bad_bool COMMAND ${CMAKE_COMMAND} -E env $<TARGET_FILE:c_fortran_bad_bool>)
 
 add_executable(cxx_fortran_bad_bool main.cpp)
 target_link_libraries(cxx_fortran_bad_bool PRIVATE bad_bool_fortran)
-add_test(NAME Cpp_Fortran_bad_bool COMMAND cxx_fortran_bad_bool)
+add_test(NAME Cpp_Fortran_bad_bool COMMAND ${CMAKE_COMMAND} -E env $<TARGET_FILE:cxx_fortran_bad_bool>)
 
 set_tests_properties(C_Fortran_bad_bool Fortran_C_bad_bool Cpp_Fortran_bad_bool PROPERTIES WILL_FAIL true)
+set_target_properties(c_fortran_bool c_fortran_bad_bool PROPERTIES LINKER_LANGUAGE C)

test/bool/bad_interface.f90

@@ -6,46 +6,51 @@ program bad_interface
 
 implicit none
 
+type, bind(C) :: bool_args
+logical(8) :: value
+integer(C_INT) :: dummy
+end type
+
 interface
-logical(C_BOOL) function logical_not(a, dint) bind(C)
-import C_INT, C_BOOL
-logical, intent(in), value :: a
-integer(C_INT), intent(in) :: dint
+logical(C_BOOL) function logical_not(args) bind(C)
+import C_BOOL, bool_args
+type(bool_args), intent(in), value :: args
 end function
 
-logical(C_BOOL) function bool_passthru(a, dint) bind(C)
-import C_INT, C_BOOL
-logical, intent(in), value :: a
-integer(C_INT), intent(in) :: dint
+logical(C_BOOL) function bool_passthru(args) bind(C)
+import C_BOOL, bool_args
+type(bool_args), intent(in), value :: args
 end function
 end interface
 
-logical :: tc, fc
+type(bool_args) :: tc, fc
 logical :: t0, f0, t1, f1
 !! show there's no warnings
 
 logical :: true_f, false_f
 
 t0 = .true.
 f0 = .false.
-tc = t0
-fc = f0
-t1 = tc
-f1 = fc
+tc%value = t0
+tc%dummy = 42_C_INT
+fc%value = f0
+fc%dummy = 42_C_INT
+t1 = tc%value
+f1 = fc%value
 
 if (.not. t1) error stop "logical(C_BOOL) .true. should be .true."
 if (.not. t1 .eqv. t0) error stop "logical(C_BOOL) .true. should EQV .true."
 if (f1) error stop "logical(C_BOOL) .false. should be .false."
 if(.not. f1 .eqv. f0) error stop "logical(C_BOOL) .false. should EQV .false."
 
-false_f = logical_not(tc, 42_C_INT)
-true_f = logical_not(fc, 42_C_INT)
+false_f = logical_not(tc)
+true_f = logical_not(fc)
 
 if (false_f) error stop "logical_not(.true.) should be .false."
 if (.not. true_f) error stop "logical_not(.false.) should be .true."
 
-false_f = bool_passthru(fc, 42_C_INT)
-true_f = bool_passthru(tc, 42_C_INT)
+false_f = bool_passthru(fc)
+true_f = bool_passthru(tc)
 
 if (false_f) error stop "bool_passthru(.false.) should be .false."
 if (.not. true_f) error stop "bool_passthru(.true.) should be .true."

test/bool/main.c

@@ -24,16 +24,16 @@ if(b){
   c++;
 }
 
-// pass a pointer to int with value 42 to check that the Fortran function receives it correctly
-int dummy = 42;
+bool_args args = { true, 42 };
 
-b = logical_not(true, &dummy);
+b = logical_not(args);
 if(b) {
   fprintf(stderr, "logical_not(true) should be false: %d\n", b);
   c++;
 }
 
-b = logical_not(false, &dummy);
+args.value = false;
+b = logical_not(args);
 if (!b) {
   fprintf(stderr, "logical_not(false) should be true: %d\n", b);
   c++;

test/bool/main.cpp

@@ -21,30 +21,31 @@ if(b){
   c++;
 }
 
-// pass a pointer to int with value 42 to check that the Fortran function receives it correctly
-int dummy = 42;
+bool_args args{true, 42};
 
-b = logical_not(true, &dummy);
+b = logical_not(args);
 
 if(b){
   std::cerr << "logical_not(true) failed: " << b << "\n";
   c++;
 }
 
-b = logical_not(false, &dummy);
+args.value = false;
+b = logical_not(args);
 
 if (!b){
   std::cerr << "logical_not(false) failed: " << b << "\n";
   c++;
 }
 
-b = bool_passthru(false, &dummy);
+b = bool_passthru(args);
 if(b){
   std::cerr << "bool_passthru(false) failed: " << b << "\n";
   c++;
 }
 
-b = bool_passthru(true, &dummy);
+args.value = true;
+b = bool_passthru(args);
 if(!b){
   std::cerr << "bool_passthru(true) failed: " << b << "\n";
   c++;