diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index c01788656..56c6f70e6 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -418,6 +418,85 @@ Returns one of the `integer` `OS_*` parameters representing the OS type, from th --- +## `FS_ERROR` - Helper function for error handling + +### Status + +Experimental + +### Description + +A helper function for returning the `type(state_type)` with the flag `STDLIB_FS_ERROR` set. + +### Syntax + +`err = FS_ERROR([a1,a2,a3,a4...... a20])` + +### Class +Pure Function + +### Arguments + +`a1,a2,a3.....a20`(optional): They are of type `class(*), dimension(..), optional, intent(in)`. +An arbitrary list of `integer`, `real`, `complex`, `character` or `string_type` variables. Numeric variables may be provided as either scalars or rank-1 (array) inputs. + +### Behavior + +Formats all the arguments into a nice error message, utilizing the constructor of [[stdlib_system(module):state_type(type)]] + +### Return values + +`type(state_type)` + +### Example + +```fortran +{!example/system/example_fs_error.f90!} +``` + +--- + +## `FS_ERROR_CODE` - Helper function for error handling (with error code) + +### Status + +Experimental + +### Description + +A helper function for returning the `type(state_type)` with the flag `STDLIB_FS_ERROR` set. +It also formats and prefixes the `code` passed to it as the first argument. + +### Syntax + +`err = FS_ERROR_CODE(code [, a1,a2,a3,a4...... a19])` + +### Class +Pure Function + +### Arguments + +`code`: An `integer` code. + +`a1,a2,a3.....a19`(optional): They are of type `class(*), dimension(..), optional, intent(in)`. +An arbitrary list of `integer`, `real`, `complex`, `character` or `string_type` variables. Numeric variables may be provided as either scalars or rank-1 (array) inputs. + +### Behavior + +Formats all the arguments into a nice error message, utilizing the constructor of [[stdlib_system(module):state_type(type)]] + +### Return values + +`type(state_type)` + +### Example + +```fortran +{!example/system/example_fs_error.f90!} +``` + +--- + ## `is_directory` - Test if a path is a directory ### Status diff --git a/example/system/CMakeLists.txt b/example/system/CMakeLists.txt index 079379c70..57ec0c737 100644 --- a/example/system/CMakeLists.txt +++ b/example/system/CMakeLists.txt @@ -11,7 +11,9 @@ ADD_EXAMPLE(process_5) ADD_EXAMPLE(process_6) ADD_EXAMPLE(process_7) ADD_EXAMPLE(sleep) +ADD_EXAMPLE(fs_error) ADD_EXAMPLE(path_join) ADD_EXAMPLE(path_split_path) ADD_EXAMPLE(path_base_name) ADD_EXAMPLE(path_dir_name) + diff --git a/example/system/example_fs_error.f90 b/example/system/example_fs_error.f90 new file mode 100644 index 000000000..29ad3e213 --- /dev/null +++ b/example/system/example_fs_error.f90 @@ -0,0 +1,23 @@ +! Demonstrate usage of `FS_ERROR`, `FS_ERROR_CODE` +program example_fs_error + use stdlib_system, only: FS_ERROR, FS_ERROR_CODE + use stdlib_error, only: state_type, STDLIB_FS_ERROR + implicit none + + type(state_type) :: err0, err1 + + err0 = FS_ERROR("Could not create directory", "`temp.dir`", "- Already exists") + + if (err0%state == STDLIB_FS_ERROR) then + ! Error encountered: Filesystem Error: Could not create directory `temp.dir` - Already exists + print *, err0%print() + end if + + err1 = FS_ERROR_CODE(1, "Could not create directory", "`temp.dir`", "- Already exists") + + if (err1%state == STDLIB_FS_ERROR) then + ! Error encountered: Filesystem Error: code - 1, Could not create directory `temp.dir` - Already exists + print *, err1%print() + end if + +end program example_fs_error diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index eb714b4a9..bf8c9f0c7 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -2,7 +2,7 @@ module stdlib_system use, intrinsic :: iso_c_binding, only : c_int, c_long, c_ptr, c_null_ptr, c_int64_t, c_size_t, & c_f_pointer use stdlib_kinds, only: int64, dp, c_bool, c_char -use stdlib_strings, only: to_c_char +use stdlib_strings, only: to_c_char, to_string use stdlib_string_type, only: string_type use stdlib_error, only: state_type, STDLIB_SUCCESS, STDLIB_FS_ERROR implicit none @@ -142,6 +142,21 @@ module stdlib_system !! On Windows, this is `NUL`. On UNIX-like systems, this is `/dev/null`. !! public :: null_device + +!! version: experimental +!! +!! A helper function for returning the `type(state_type)` with the flag `STDLIB_FS_ERROR` set. +!! ([Specification](../page/specs/stdlib_system.html#FS_ERROR)) +!! +public :: FS_ERROR + +!! version: experimental +!! +!! A helper function for returning the `type(state_type)` with the flag `STDLIB_FS_ERROR` set. +!! It also formats and prefixes the `code` passed to it as the first argument +!! ([Specification](../page/specs/stdlib_system.html#FS_ERROR_CODE)) +!! +public :: FS_ERROR_CODE ! CPU clock ticks storage integer, parameter, private :: TICKS = int64 @@ -914,6 +929,36 @@ subroutine delete_file(path, err) end if end subroutine delete_file +pure function FS_ERROR_CODE(code,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,& + a11,a12,a13,a14,a15,a16,a17,a18,a19) result(state) + + type(state_type) :: state + !> Platform specific error code + integer, intent(in) :: code + !> Optional rank-agnostic arguments + class(*), intent(in), optional, dimension(..) :: a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,& + a11,a12,a13,a14,a15,a16,a17,a18,a19 + + character(32) :: code_msg + + write(code_msg, "('code - ', i0, ',')") code + + state = state_type(STDLIB_FS_ERROR, code_msg,a1,a2,a3,a4,a5,a6,a7,a8,& + a9,a10,a11,a12,a13,a14,a15,a16,a17,a18,a19) +end function FS_ERROR_CODE + +pure function FS_ERROR(a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,& + a12,a13,a14,a15,a16,a17,a18,a19,a20) result(state) + + type(state_type) :: state + !> Optional rank-agnostic arguments + class(*), intent(in), optional, dimension(..) :: a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,& + a11,a12,a13,a14,a15,a16,a17,a18,a19,a20 + + state = state_type(STDLIB_FS_ERROR, a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,& + a13,a14,a15,a16,a17,a18,a19,a20) +end function FS_ERROR + character function path_sep() if (OS_TYPE() == OS_WINDOWS) then path_sep = '\' diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index 4cf1690e4..838ced263 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -1,7 +1,7 @@ module test_filesystem use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test - use stdlib_system, only: is_directory, delete_file - use stdlib_error, only: state_type + use stdlib_system, only: is_directory, delete_file, FS_ERROR, FS_ERROR_CODE + use stdlib_error, only: state_type, STDLIB_FS_ERROR implicit none @@ -13,6 +13,7 @@ subroutine collect_suite(testsuite) type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & + new_unittest("fs_error", test_fs_error), & new_unittest("fs_is_directory_dir", test_is_directory_dir), & new_unittest("fs_is_directory_file", test_is_directory_file), & new_unittest("fs_delete_non_existent", test_delete_file_non_existent), & @@ -21,6 +22,26 @@ subroutine collect_suite(testsuite) ] end subroutine collect_suite + subroutine test_fs_error(error) + type(error_type), allocatable, intent(out) :: error + type(state_type) :: s1, s2 + character(:), allocatable :: msg + + msg = "code - 10, Cannot create File temp.txt - File already exists" + s1 = FS_ERROR_CODE(10, "Cannot create File temp.txt -", "File already exists") + + call check(error, s1%state == STDLIB_FS_ERROR .and. s1%message == msg, & + "FS_ERROR_CODE: Could not construct the state with code correctly") + if (allocated(error)) return + + msg = "Cannot create File temp.txt - File already exists" + s2 = FS_ERROR("Cannot create File temp.txt -", "File already exists") + + call check(error, s2%state == STDLIB_FS_ERROR .and. s2%message == msg, & + "FS_ERROR: Could not construct state without code correctly") + if (allocated(error)) return + end subroutine test_fs_error + ! Test `is_directory` for a directory subroutine test_is_directory_dir(error) type(error_type), allocatable, intent(out) :: error