Skip to content

Commit c99a86f

Browse files
committed
added type and procedures
1 parent 25f94a9 commit c99a86f

File tree

1 file changed

+75
-0
lines changed

1 file changed

+75
-0
lines changed

src/stdlib_system.F90

Lines changed: 75 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -198,6 +198,32 @@ module stdlib_system
198198

199199
end type process_type
200200

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+
201227
interface runasync
202228
!! version: experimental
203229
!!
@@ -770,4 +796,53 @@ subroutine delete_file(path, err)
770796
end if
771797
end subroutine delete_file
772798

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+
773848
end module stdlib_system

0 commit comments

Comments
 (0)