Advancements and bubble-up working (message only)

Author: mzecc

Makefile

@@ -52,7 +52,8 @@ test:  ## run the tests (re-installs the package every time so you might want to
 	uv run --no-sync python scripts/inject-srcs-into-meson-build.py
 	uv run --no-sync python -c 'from pathlib import Path; import example_fgen_basic' || ( echo "Run make virtual-environment first" && false )
 	COV_DIR=$$(uv run --no-sync python -c 'from pathlib import Path; import example_fgen_basic; print(Path(example_fgen_basic.__file__).parent)'); \
-		uv run --no-editable --reinstall-package example-fgen-basic pytest -r a -v tests src --doctest-modules --doctest-report ndiff --cov=$$COV_DIR
+		# uv run --no-editable --reinstall-package example-fgen-basic pytest -s -r a -v tests/unit/test_result_dp.py --doctest-modules --doctest-report ndiff --cov=$$COV_DIR
+		uv run --no-editable --reinstall-package example-fgen-basic pytest -s -r a -v tests/unit/test_result_dp.py src --doctest-modules --doctest-report ndiff --cov=$$COV_DIR
 
 # Note on code coverage and testing:
 # You must specify cov=src.

src/example_fgen_basic/error_v/creation_wrapper.f90

@@ -39,7 +39,7 @@ function create_error(inv) result(res_instance_index)
         ! This is the major trick for wrapping.
         ! We return instance indexes (integers) to Python rather than the instance itself.
 
-        type(ErrorV) :: res
+        type(ErrorV) :: res, err
 
         ! Do the Fortran call
         res = o_create_error(inv)
@@ -51,7 +51,8 @@ function create_error(inv) result(res_instance_index)
 
         ! Set the derived type value in the manager's array,
         ! ready for its attributes to be retrieved from Python.
-        call error_v_manager_set_instance_index_to(res_instance_index, res)
+        err = error_v_manager_set_instance_index_to(res_instance_index, res)
+        !MZ: check for errors ?
 
     end function create_error
 
@@ -72,7 +73,7 @@ function create_errors(invs, n) result(res_instance_indexes)
         !
         ! This is the major trick for wrapping.
         ! We return instance indexes (integers) to Python rather than the instance itself.
-
+        type(ErrorV) :: err
         type(ErrorV), dimension(n) :: res
 
         integer :: i, tmp
@@ -91,7 +92,8 @@ function create_errors(invs, n) result(res_instance_indexes)
             call error_v_manager_get_available_instance_index(tmp)
             ! Set the derived type value in the manager's array,
             ! ready for its attributes to be retrieved from Python.
-            call error_v_manager_set_instance_index_to(tmp, res(i))
+            err = error_v_manager_set_instance_index_to(tmp, res(i))
+            !MZ: check for errors ?
             ! Set the result in the output array
             res_instance_indexes(i) = tmp
 

src/example_fgen_basic/error_v/error_v.f90

@@ -16,53 +16,96 @@ module m_error_v
     !! Code that indicates no error
 
     type, public :: ErrorV
-    !! Error value
+        !! Error value
 
         integer :: code = 1
         !! Error code
 
-        character(len=128) :: message = ""
+        character(len=:), allocatable :: message
         !! Error message
         ! TODO: think about making the message allocatable to handle long messages
 
         ! TODO: think about adding idea of critical
         ! (means you can stop but also unwind errors and traceback along the way)
 
         ! TODO: think about adding trace (might be simpler than compiling with traceback)
-        ! type(ErrorV), allocatable, dimension(:) :: causes
+!         class(ErrorV), allocatable :: cause
+        type(ErrorV), pointer :: cause => null()
 
     contains
 
         private
 
         procedure, public :: build
         procedure, public :: finalise
+!        procedure, public :: get_error_message
         final :: finalise_auto
         ! get_res sort of not needed (?)
         ! get_err sort of not needed (?)
 
     end type ErrorV
 
     interface ErrorV
-    !! Constructor interface - see build (TODO: figure out cross-ref syntax) for details
+        !! Constructor interface - see build (TODO: figure out cross-ref syntax) for details
         module procedure :: constructor
     end interface ErrorV
 
 contains
 
-    function constructor(code, message) result(self)
+!    pure recursive function get_error_message(self) result(full_msg)
+!
+!        class(ErrorV), target, intent(in) :: self
+!
+!        character(len=:), allocatable :: full_msg
+!        character(len=:), allocatable :: cause_msg
+!
+!        full_msg = self%message
+!        if (associated(self%cause)) then
+!            cause_msg = self%cause%get_error_message()
+!            full_msg = trim(full_msg) // ' Previous error: ' // trim(cause_msg)
+!        end if
+!
+!    end function
+!        function get_error_message(self) result(full_msg)
+!
+!            class(ErrorV), target, intent(in) :: self
+!            class(ErrorV), pointer :: p_errorv
+!
+!            character(len=:), allocatable :: full_msg
+!
+!            full_msg = ""
+!
+!            if (allocated(self%message)) full_msg = trim(self%message)
+!            p_errorv => self
+!
+!            do while (associated(p_errorv))
+!
+!                if(len(full_msg)>0)then
+!                    full_msg = trim(full_msg) // " --> Cause: " // p_errorv % message
+!                else
+!                    full_msg = p_errorv % message
+!                end if
+!
+!                p_errorv => p_errorv % cause
+!
+!            end do
+!
+!        end function
+
+    function constructor(code, message, cause) result(self)
         !! Constructor - see build (TODO: figure out cross-ref syntax) for details
 
         integer, intent(in) :: code
         character(len=*), optional, intent(in) :: message
+        type(ErrorV), target, optional, intent(in) :: cause
 
         type(ErrorV) :: self
 
-        call self % build(code, message)
+        call self % build(code, message, cause)
 
     end function constructor
 
-    subroutine build(self, code, message)
+    subroutine build(self, code, message, cause)
         !! Build instance
 
         class(ErrorV), intent(inout) :: self
@@ -75,10 +118,25 @@ subroutine build(self, code, message)
 
         character(len=*), optional, intent(in) :: message
         !! Error message
+        type(ErrorV), target, optional, intent(in) :: cause
 
         self % code = code
-        if (present(message)) then
-            self % message = message
+
+        if (present(cause)) then
+!            self % cause => cause
+!            allocate(self % cause)
+!            call self%cause%build(cause%code, cause%message, cause%cause)
+!            self%cause = cause
+            if (present(message)) then
+                self % message = trim(message) // " --> Cause: " // cause % message
+            else
+                self % message = " --> Cause: " // cause % message
+            end if
+
+        else
+            if (present(message)) then
+                self % message = trim(message)
+            end if
         end if
 
     end subroutine build
@@ -91,7 +149,13 @@ subroutine finalise(self)
 
         ! If we make message allocatable, deallocate here
         self % code = 1
-        self % message = ""
+        if (allocated(self%message)) deallocate(self%message)
+        ! MZ when the object is finalized or goes out of scope, its pointer components are destroyed.
+        ! Hopefully no shared ownership??
+        if (associated(self%cause))then
+            deallocate(self%cause)
+            nullify(self%cause)
+        end if
 
     end subroutine finalise