@@ -198,6 +198,32 @@ module stdlib_system
198
198
199
199
end type process_type
200
200
201
+ ! For Fileystem related error handling
202
+ type, public :: fs_error
203
+ ! the status code returned by C-functions or
204
+ ! global variables like `errno` etc whenever called
205
+ ! When no C interface is involved but there is an error it is set to -1
206
+ integer :: code = 0
207
+
208
+ ! A user friendly message about the error
209
+ character (len= 128 ) :: message = repeat (' ' , 128 )
210
+
211
+ contains
212
+ ! resets the error state
213
+ procedure :: destroy = > fs_error_destroy
214
+
215
+ ! returns the formatted error message
216
+ procedure :: print = > fs_error_message
217
+
218
+ ! > properties
219
+ procedure :: ok = > fs_error_is_ok
220
+ procedure :: error = > fs_error_is_error
221
+
222
+ ! > Handle optional error message
223
+ procedure :: handle = > fs_error_handling
224
+
225
+ end type fs_error
226
+
201
227
interface runasync
202
228
! ! version: experimental
203
229
! !
@@ -770,4 +796,53 @@ subroutine delete_file(path, err)
770
796
end if
771
797
end subroutine delete_file
772
798
799
+ elemental subroutine fs_error_destroy (this )
800
+ class(fs_error), intent (inout ) :: this
801
+
802
+ this% code = 0
803
+ this% message = repeat (' ' , len (this% message))
804
+ end subroutine fs_error_destroy
805
+
806
+ pure function fs_error_message (this ) result(msg)
807
+ class(fs_error), intent (in ) :: this
808
+ character (len= :), allocatable :: msg
809
+ character (len= 7 ) :: tmp ! should be more than enough
810
+
811
+ if (this% code == 0 ) then
812
+ msg = ' No Error!'
813
+ else
814
+ write (tmp, ' (i0)' ) this% code
815
+ msg = ' Filesystem Error, code ' // trim (tmp)// ' : ' // trim (this% message)
816
+ end if
817
+ end function fs_error_message
818
+
819
+ elemental function fs_error_is_ok (this ) result(is_ok)
820
+ class(fs_error), intent (in ) :: this
821
+ logical :: is_ok
822
+ is_ok = this% code == 0
823
+ end function fs_error_is_ok
824
+
825
+ elemental function fs_error_is_error (this ) result(is_err)
826
+ class(fs_error), intent (in ) :: this
827
+ logical :: is_err
828
+ is_err = this% code /= 0
829
+ end function fs_error_is_error
830
+
831
+ pure subroutine fs_error_handling (err ,err_out )
832
+ class(fs_error), intent (in ) :: err
833
+ class(fs_error), optional , intent (inout ) :: err_out
834
+
835
+ character (len= :),allocatable :: err_msg
836
+
837
+ if (present (err_out)) then
838
+ ! copy err into err_out
839
+ err_out% code = err% code
840
+ err_out% message = err% message
841
+ else if (err% error()) then
842
+ ! stop the program
843
+ err_msg = err% print ()
844
+ error stop err_msg
845
+ end if
846
+ end subroutine fs_error_handling
847
+
773
848
end module stdlib_system
0 commit comments