diff --git a/src/example_fgen_basic/error_v/error_v.f90 b/src/example_fgen_basic/error_v/error_v.f90 index 6cf8d30..e433bf3 100644 --- a/src/example_fgen_basic/error_v/error_v.f90 +++ b/src/example_fgen_basic/error_v/error_v.f90 @@ -21,7 +21,7 @@ module m_error_v integer :: code = 1 !! Error code - character(len=128) :: message = "" + character(len=512) :: message = "" !! Error message ! TODO: think about making the message allocatable to handle long messages diff --git a/src/example_fgen_basic/error_v/error_v_wrapper.f90 b/src/example_fgen_basic/error_v/error_v_wrapper.f90 index 893a86d..5537634 100644 --- a/src/example_fgen_basic/error_v/error_v_wrapper.f90 +++ b/src/example_fgen_basic/error_v/error_v_wrapper.f90 @@ -118,7 +118,7 @@ subroutine get_message( & integer, intent(in) :: instance_index ! TODO: make this variable length - character(len=128), intent(out) :: message + character(len=512), intent(out) :: message type(ErrorV) :: instance diff --git a/src/example_fgen_basic/get_square_root_wrapper.f90 b/src/example_fgen_basic/get_square_root_wrapper.f90 index d1b3bc0..e1c2257 100644 --- a/src/example_fgen_basic/get_square_root_wrapper.f90 +++ b/src/example_fgen_basic/get_square_root_wrapper.f90 @@ -2,6 +2,7 @@ module m_get_square_root_w use m_result_dp, only: ResultDP + use m_result_int, only: ResultInt use m_get_square_root, only: o_get_square_root => get_square_root ! The manager module, which makes this all work @@ -30,13 +31,18 @@ function get_square_root(inv) result(res_instance_index) !! Instance index of the result type type(ResultDP) :: res + type(ResultInt) :: res_get_available_instance_index res = o_get_square_root(inv) call result_dp_manager_ensure_instance_array_size_is_at_least(1) ! Get the instance index to return to Python - call result_dp_manager_get_available_instance_index(res_instance_index) + call result_dp_manager_get_available_instance_index(res_get_available_instance_index) + + ! Logic here is trickier. + ! If you can't create a result type to return to Python, + ! then you also can't return errors so you're a bit cooked. ! Set the derived type value in the manager's array, ! ready for its attributes to be retrieved from Python. diff --git a/src/example_fgen_basic/result/result_dp_manager.f90 b/src/example_fgen_basic/result/result_dp_manager.f90 index e46c366..81d60fa 100644 --- a/src/example_fgen_basic/result/result_dp_manager.f90 +++ b/src/example_fgen_basic/result/result_dp_manager.f90 @@ -19,7 +19,7 @@ module m_result_dp_manager contains - subroutine build_instance(data_v_in, error_v_in, res_available_instance_index) + subroutine build_instance(data_v_in, error_v_in, res) !! Build an instance real(kind=dp), intent(in), optional :: data_v_in @@ -28,27 +28,45 @@ subroutine build_instance(data_v_in, error_v_in, res_available_instance_index) class(ErrorV), intent(in), optional :: error_v_in !! Error message - type(ResultInt) , intent(out) :: res_available_instance_index - !! Index of the built instance + type(ResultInt) , intent(out) :: res + !! Result i.e. index of the built instance (within a result type) type(ResultNone) :: res_build call ensure_instance_array_size_is_at_least(1) - call get_available_instance_index(res_available_instance_index) + ! ! TODO: switch to + ! instance_index = get_available_instance_index() + call get_available_instance_index(res) - if (res_available_instance_index % is_error()) return + if (res % is_error()) then + ! Already hit an error, quick return + return + end if - call instance_array(res_available_instance_index%data_v) % & - build(data_v_in=data_v_in, error_v_in=error_v_in, res=res_build) + call instance_array(res%data_v) % build( & + data_v_in=data_v_in, error_v_in=error_v_in, res=res_build & + ) - ! Check if build failed - if (res_build % is_error()) then - ! free slot again - instance_available(res_available_instance_index%data_v) = .true. - ! bubble the error up as ResultInt - res_available_instance_index = ResultInt(error_v=res_build%error_v) + if (.not. (res_build % is_error())) then + ! All happy + return end if + ! Error occured + ! + ! Free the slot again + instance_available(res % data_v) = .true. + + ! Bubble the error up. + ! This is a good example of where stacking errors would be nice. + ! It would be great to be able to say, + ! "We got an instance index, + ! but when we tried to build the instance, + ! the following error occured...". + ! (Stacking error messages like this + ! would even let us do stack traces in a way...) + res = ResultInt(error_v=res_build%error_v) + end subroutine build_instance subroutine finalise_instance(instance_index) @@ -76,8 +94,8 @@ subroutine get_available_instance_index(res_available_instance_index) ! and something goes wrong (maybe we need a lock) type(ResultInt), intent(out) :: res_available_instance_index - ! integer, intent(out) :: available_instance_index !! Available instance index + integer :: i do i = 1, size(instance_array) @@ -85,8 +103,6 @@ subroutine get_available_instance_index(res_available_instance_index) if (instance_available(i)) then instance_available(i) = .false. - ! available_instance_index = i - ! TODO: switch to returning a Result type res_available_instance_index = ResultInt(data_v=i) return @@ -94,9 +110,15 @@ subroutine get_available_instance_index(res_available_instance_index) end do - ! TODO: switch to returning a Result type with an error set - ! error stop 1 - res_available_instance_index = ResultInt(error_v=ErrorV(code=1, message="No available instances")) + res_available_instance_index = ResultInt( & + error_v=ErrorV( & + code=1, & + message="No available instances" & + ! TODO: add total number of instances to the error message + ! as that is useful information when debugging + ! (requires a int_to_str function first) + ) & + ) end subroutine get_available_instance_index diff --git a/src/example_fgen_basic/result/result_dp_wrapper.f90 b/src/example_fgen_basic/result/result_dp_wrapper.f90 index a4421a6..49ba40d 100644 --- a/src/example_fgen_basic/result/result_dp_wrapper.f90 +++ b/src/example_fgen_basic/result/result_dp_wrapper.f90 @@ -19,6 +19,12 @@ module m_result_dp_w result_dp_manager_get_instance => get_instance, & result_dp_manager_ensure_instance_array_size_is_at_least => ensure_instance_array_size_is_at_least + use m_result_int_manager, only: & + result_int_manager_ensure_instance_array_size_is_at_least => ensure_instance_array_size_is_at_least, & + result_int_manager_get_available_instance_index => get_available_instance_index, & + result_int_manager_set_instance_index_to => set_instance_index_to, & + result_int_manager_force_claim_instance_index => force_claim_instance_index + implicit none private @@ -32,34 +38,92 @@ module m_result_dp_w contains - subroutine build_instance(data_v, error_v_instance_index, res_available_instance_index) + subroutine build_instance(data_v, error_v_instance_index, res_build_instance_index) !! Build an instance - real(kind=dp), intent(in), optional :: data_v + ! Optional in wrappers a bad idea as f2py does something funny. + ! Have to use some 'not supplied' equivalent instead. + real(kind=dp), intent(in) :: data_v !! Data - integer, intent(in), optional :: error_v_instance_index + integer, intent(in) :: error_v_instance_index !! Error - type(ResultInt), intent(out) :: res_available_instance_index - !! Instance index of the built instance + integer, intent(out) :: res_build_instance_index + !! Instance index of the result of trying to build the instance ! ! This is the major trick for wrapping. - ! We pass instance indexes (integers) to Python rather than the instance itself. + ! We pass instance indexes (integers) back to Python rather than the instance itself. + + type(ResultInt) :: res_build + type(ResultInt) :: res_int_get_available_instance_index ! This is the major trick for wrapping derived types with other derived types as attributes. ! We use the manager layer to initialise the attributes before passing on. type(ErrorV) :: error_v - if (present(error_v_instance_index)) then + ! In wrapper layer, something always gets passed by f2py. + ! Assume that any error_v_instance_index greater than 0 indicates that the error is what we want + ! (check this first as there is no `None` in Fortran/f2py we can use to check data instead). + if (error_v_instance_index > 0) then error_v = error_v_manager_get_instance(error_v_instance_index) + call result_dp_manager_build_instance( & + error_v_in=error_v, & + res=res_build & + ) + else - ! No error provided: initialize empty error - error_v%code = NO_ERROR_CODE - error_v%message = "" + ! Assume no error + call result_dp_manager_build_instance( & + data_v_in=data_v, & + res=res_build & + ) + end if - call result_dp_manager_build_instance(data_v, error_v, res_available_instance_index) + ! Get the instance index to return to Python + call result_int_manager_get_available_instance_index(res_int_get_available_instance_index) + + if (.not. (res_int_get_available_instance_index % is_error())) then + ! Could allocate a result type to handle the return to Python. + ! + ! Set the derived type value in the manager's array, + ! ready for its attributes to be retrieved from Python. + call result_int_manager_set_instance_index_to( & + ! Hmm ok downcasting maybe not so smart + int(res_int_get_available_instance_index % data_v, kind=4), & + res_build & + ) + + return + + end if + + ! Could not allocate a result type to handle the return to Python. + ! + ! Logic here is trickier. + ! If you can't create a result type to return to Python, + ! then you also can't return errors so you're stuck. + ! As an escape hatch + call result_int_manager_ensure_instance_array_size_is_at_least(1) + res_build_instance_index = 1 + + ! Just use the first instance and write a message that the program + ! is fully broken. + res_build = ResultInt( & + error_v = ErrorV( & + code=1, & + message=( & + "I wanted to return an error, " & + // "but I couldn't even get an available instance to do so. " & + // "I have forced a return, but your program is probably fully broken. " & + // "Please be very careful." & + ) & + ) & + ) + + call result_int_manager_force_claim_instance_index(res_build_instance_index) + call result_int_manager_set_instance_index_to(res_build_instance_index, res_build) end subroutine build_instance diff --git a/src/example_fgen_basic/result/result_int_manager.f90 b/src/example_fgen_basic/result/result_int_manager.f90 index 6a22d40..1e65b0d 100644 --- a/src/example_fgen_basic/result/result_int_manager.f90 +++ b/src/example_fgen_basic/result/result_int_manager.f90 @@ -13,12 +13,14 @@ module m_result_int_manager logical, dimension(:), allocatable :: instance_available ! TODO: think about ordering here, alphabetical probably easiest - public :: build_instance, finalise_instance, get_available_instance_index, get_instance, set_instance_index_to, & + public :: build_instance, finalise_instance, & + get_available_instance_index, force_claim_instance_index, & + get_instance, set_instance_index_to, & ensure_instance_array_size_is_at_least contains - function build_instance(data_v_in, error_v_in) result(instance_index) + function build_instance(data_v_in, error_v_in) result(res_instance_index) !! Build an instance integer(kind=i8), intent(in), optional :: data_v_in @@ -27,15 +29,44 @@ function build_instance(data_v_in, error_v_in) result(instance_index) class(ErrorV), intent(in), optional :: error_v_in !! Error message - integer :: instance_index - !! Index of the built instance + type(ResultInt) :: res_instance_index + !! Result i.e. index of the built instance (within a result type) type(ResultNone) :: res_build call ensure_instance_array_size_is_at_least(1) - call get_available_instance_index(instance_index) - call instance_array(instance_index) % build(data_v_in=data_v_in, error_v_in=error_v_in, res=res_build) - ! TODO: check build has no error + ! ! TODO: switch to + ! instance_index = get_available_instance_index() + call get_available_instance_index(res_instance_index) + + if (res_instance_index % is_error()) then + ! Already hit an error, quick return + return + end if + + call instance_array(res_instance_index%data_v) % build( & + data_v_in=data_v_in, error_v_in=error_v_in, res=res_build & + ) + + if (.not. (res_build % is_error())) then + ! All happy + return + end if + + ! Error occured + ! + ! Free the slot again + instance_available(res_instance_index % data_v) = .true. + + ! Bubble the error up. + ! This is a good example of where stacking errors would be nice. + ! It would be great to be able to say, + ! "We got an instance index, + ! but when we tried to build the instance, + ! the following error occured...". + ! (Stacking error messages like this + ! would even let us do stack traces in a way...) + res_instance_index = ResultInt(error_v=res_build%error_v) end function build_instance @@ -52,7 +83,7 @@ subroutine finalise_instance(instance_index) end subroutine finalise_instance - subroutine get_available_instance_index(available_instance_index) + subroutine get_available_instance_index(res_available_instance_index) !! Get a free instance index ! TODO: think through whether race conditions are possible @@ -61,31 +92,60 @@ subroutine get_available_instance_index(available_instance_index) ! and something goes wrong (maybe we need a lock) ! MZ: I think this is of order O(N) that for large arrays can be very slow ! maybe use something like linked lists?? / - integer, intent(out) :: available_instance_index + + type(ResultInt), intent(out) :: res_available_instance_index !! Available instance index integer :: i + if (.not. allocated(instance_array)) then + + res_available_instance_index = ResultInt( & + error_v=ErrorV( & + code=1, & + message="instance_array has not been allocated yet" & + ) & + ) + return + + end if + do i = 1, size(instance_array) if (instance_available(i)) then instance_available(i) = .false. - available_instance_index = i - ! TODO: switch to returning a Result type - ! res = ResultInt(data=i) + res_available_instance_index = ResultInt(data_v=i) return end if end do - ! TODO: switch to returning a Result type with an error set - ! res = ResultInt(ResultInt(code=1, message="No available instances")) - error stop 1 + res_available_instance_index = ResultInt( & + error_v=ErrorV( & + code=1, & + message="No available instances" & + ! TODO: add total number of instances to the error message + ! as that is useful information when debugging + ! (requires a int_to_str function first) + ) & + ) end subroutine get_available_instance_index + subroutine force_claim_instance_index(instance_index) + + integer, intent(in) :: instance_index + !! Instnace index of which to force claim + !! + !! Whether it has already been claimed or not, + !! the instance at this index will be set as being claimed. + + instance_available(instance_index) = .false. + + end subroutine force_claim_instance_index + ! Change to pure function when we update check_index_claimed to be pure function get_instance(instance_index) result(inst) @@ -100,14 +160,27 @@ function get_instance(instance_index) result(inst) end function get_instance - subroutine set_instance_index_to(instance_index, val) + subroutine set_instance_index_to(instance_index, val, check_claimed) integer, intent(in) :: instance_index !! Index in `instance_array` of which to set the value equal to `val` type(ResultInt), intent(in) :: val - call check_index_claimed(instance_index) + logical, intent(in), optional :: check_claimed + + logical :: a_check_claimed + + if (present(check_claimed)) then + a_check_claimed = check_claimed + else + a_check_claimed = .true. + end if + + if (a_check_claimed) then + call check_index_claimed(instance_index) + end if + instance_array(instance_index) = val ! MZ: Shouldn't be instance_available be set to .false.? diff --git a/src/example_fgen_basic/result/result_int_wrapper.f90 b/src/example_fgen_basic/result/result_int_wrapper.f90 index ade14cc..b0385ef 100644 --- a/src/example_fgen_basic/result/result_int_wrapper.f90 +++ b/src/example_fgen_basic/result/result_int_wrapper.f90 @@ -45,13 +45,18 @@ subroutine build_instance(data_v, error_v_instance_index, instance_index) ! This is the major trick for wrapping. ! We pass instance indexes (integers) to Python rather than the instance itself. + type(ResultInt) :: res_instance_index + ! This is the major trick for wrapping derived types with other derived types as attributes. ! We use the manager layer to initialise the attributes before passing on. type(ErrorV) :: error_v error_v = error_v_manager_get_instance(error_v_instance_index) - instance_index = result_int_manager_build_instance(data_v, error_v) + res_instance_index = result_int_manager_build_instance(data_v, error_v) + + ! TODO: add all the error handling + instance_index = res_instance_index % data_v end subroutine build_instance diff --git a/tests/unit/test_result_dp.py b/tests/unit/test_result_dp.py new file mode 100644 index 0000000..4567e56 --- /dev/null +++ b/tests/unit/test_result_dp.py @@ -0,0 +1,22 @@ +from example_fgen_basic._lib import m_result_dp_w +from example_fgen_basic.result.result_int import ResultInt + + +def test_build_no_argument_supplied(): + res_instance_index: int = m_result_dp_w.build_instance( + data_v=1.23, error_v_instance_index=0 + ) + res: ResultInt = ResultInt.from_instance_index(res_instance_index) + # Previously this would segfault. + # Now we can actually handle the error on the Python side as we wish + # rather than our only choice being a seg fault or hard stop in Fortran + # (for this particular error message, + # probably the Python just has to raise an exception too, + # but other errors will be things we can recover). + assert res.has_error + assert res.error_v.message == ( + "I wanted to return an error, " + "but I couldn't even get an available instance to do so. " + "I have forced a return, but your program is probably fully broken. " + "Please be very careful." + )