poly_function more tests and status

Author: scivision

src/poly_function/c_interface_poly.f90

@@ -12,6 +12,10 @@ module c_interface_poly
   integer(c_int), parameter :: STATUS_ZERO_DIMS = 3_c_int
   integer(c_int), parameter :: STATUS_ALLOC_FAIL = 4_c_int
   integer(c_int), parameter :: STATUS_BAD_OBJECT_PTR = 5_c_int
+  integer(c_int), parameter :: STATUS_FORTDATA_PTR = 6_c_int
+  integer(c_int), parameter :: STATUS_SET_DATA_DEALLOC_FAIL = 7_c_int
+  integer(c_int), parameter :: STATUS_SET_DATA_ALLOC_FAIL = 8_c_int
+  integer(c_int), parameter :: STATUS_DESTRUCT_DEALLOC_FAIL = 9_c_int
 
 contains
 
@@ -27,6 +31,7 @@ integer(c_int) function objconstruct_C(objtype,cptr_f90obj,cptr_indata,lx,ly) bi
   type(data2), pointer :: tmpobj2    !< ditto
   real(c_float), dimension(:,:), pointer :: fortdata
   integer :: alloc_status
+  integer(c_int) :: data_status
 
   !> nullify for sake of clarity and good practice
   nullify(tmpobj1, tmpobj2)
@@ -69,7 +74,25 @@ integer(c_int) function objconstruct_C(objtype,cptr_f90obj,cptr_indata,lx,ly) bi
   !> initialize some test data, and call methods to print
   print*, 'Initializing test data...'
   call c_f_pointer(cptr_indata,fortdata,shape=[lx,ly])
-  call obj%set_data(fortdata)
+  if (.not. associated(fortdata)) then
+    objconstruct_C = STATUS_FORTDATA_PTR
+    return
+  end if
+
+  data_status = obj%set_data(fortdata)
+  select case (data_status)
+    case (0_c_int)
+      continue
+    case (1_c_int)
+      objconstruct_C = STATUS_SET_DATA_DEALLOC_FAIL
+      return
+    case (2_c_int)
+      objconstruct_C = STATUS_SET_DATA_ALLOC_FAIL
+      return
+    case default
+      objconstruct_C = STATUS_SET_DATA_ALLOC_FAIL
+      return
+  end select
 
   !! note lack of deallocate and nullify here; we need memory allocated to persist past the return.
 end function objconstruct_C
@@ -139,6 +162,7 @@ integer(c_int) function destruct_C(objtype, objC) bind(C, name='destruct_C')
 
 class(dataobj_poly),pointer :: obj
 integer(c_int) :: status
+integer :: dealloc_status
 
 destruct_C = STATUS_SUCCESS
 if (.not. c_associated(objC)) return
@@ -149,8 +173,20 @@ integer(c_int) function destruct_C(objtype, objC) bind(C, name='destruct_C')
   return
 end if
 
-if (associated(obj%dataval)) deallocate(obj%dataval)
-deallocate(obj)
+if (associated(obj%dataval)) then
+  deallocate(obj%dataval, stat=dealloc_status)
+  if (dealloc_status /= 0) then
+    destruct_C = STATUS_DESTRUCT_DEALLOC_FAIL
+    return
+  end if
+end if
+
+deallocate(obj, stat=dealloc_status)
+if (dealloc_status /= 0) then
+  destruct_C = STATUS_DESTRUCT_DEALLOC_FAIL
+  return
+end if
+
 objC = c_null_ptr
 
 end function destruct_C

src/poly_function/datamod_poly.f90

@@ -33,12 +33,14 @@ module datamod_poly
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 !! type-bound procedures
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-subroutine set_data(self,array)
+integer(c_int) function set_data(self,array)
   class(dataobj_poly), intent(inout) :: self
   real(c_float), dimension(:,:), intent(in) :: array
   integer(c_int) :: nx, ny
   integer(c_int) :: dealloc_status, alloc_status
 
+  set_data = 0_c_int
+
   nx = size(array,1)
   ny = size(array,2)
 
@@ -51,16 +53,22 @@ subroutine set_data(self,array)
       return
     end if
     deallocate(self%dataval, stat=dealloc_status)
-    if (dealloc_status /= 0) return
+    if (dealloc_status /= 0) then
+      set_data = 1_c_int
+      return
+    end if
   end if
 
   allocate(self%dataval(nx,ny), stat=alloc_status)
-  if (alloc_status /= 0) return
+  if (alloc_status /= 0) then
+    set_data = 2_c_int
+    return
+  end if
 
   self%lx = nx
   self%ly = ny
   self%dataval(:,:)=array(:,:)
-end subroutine set_data
+end function set_data
 
 
 subroutine print_data(self)

src/poly_function/my_polyfcn.h

@@ -1,5 +1,18 @@
 #include <stddef.h>
 
+enum {
+	POLY_STATUS_SUCCESS = 0,
+	POLY_STATUS_INVALID_TYPE = 1,
+	POLY_STATUS_NULL_PTR = 2,
+	POLY_STATUS_ZERO_DIMS = 3,
+	POLY_STATUS_ALLOC_FAIL = 4,
+	POLY_STATUS_BAD_OBJECT_PTR = 5,
+	POLY_STATUS_FORTDATA_PTR = 6,
+	POLY_STATUS_SET_DATA_DEALLOC_FAIL = 7,
+	POLY_STATUS_SET_DATA_ALLOC_FAIL = 8,
+	POLY_STATUS_DESTRUCT_DEALLOC_FAIL = 9
+};
+
 #ifdef __cplusplus
 extern "C" {
 #endif

test/poly_function/main.cpp

@@ -7,6 +7,10 @@
 // 3: zero dimensions in constructor
 // 4: allocation failure
 // 5: invalid/stale object pointer
+// 6: invalid C->Fortran input data pointer mapping
+// 7: set_data deallocation failure
+// 8: set_data allocation failure
+// 9: destruct deallocation failure
 #include <array>
 #include <iostream>
 #include <cstdlib>
@@ -156,5 +160,28 @@ if (status != 0) {
 	return EXIT_FAILURE;
 }
 
+// Invalid-type destroy should return invalid type status when handle is non-null.
+void* invalid_type_obj = nullptr;
+objtype = 1;
+status = objconstruct_C(&objtype, &invalid_type_obj, &arrptr, &lx1, &ly1);
+if (status != 0) {
+	std::cerr << "Failed to construct invalid_type_obj with status " << status << "\n";
+	return EXIT_FAILURE;
+}
+
+objtype = 999;
+status = destruct_C(&objtype, &invalid_type_obj);
+if (status != 1) {
+	std::cerr << "Expected invalid objtype status 1 from destruct_C, got " << status << "\n";
+	return EXIT_FAILURE;
+}
+
+objtype = 1;
+status = destruct_C(&objtype, &invalid_type_obj);
+if (status != 0) {
+	std::cerr << "Cleanup destruct_C failed for invalid_type_obj with status " << status << "\n";
+	return EXIT_FAILURE;
+}
+
 return EXIT_SUCCESS;
 }