From e7a3a1ffec018c13cc48447c7106ddf620542868 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Sat, 12 Jul 2025 17:41:18 +0530 Subject: [PATCH 1/8] added functions --- src/stdlib_system.F90 | 35 ++++++++++++++++++++++++++++++++++- 1 file changed, 34 insertions(+), 1 deletion(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index a9c3e4d55..37729cb96 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_error, only: state_type, STDLIB_SUCCESS, STDLIB_FS_ERROR implicit none private @@ -133,6 +133,13 @@ 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. +!! `FS_ERROR_CODE` also prefixes the `code` passed to it as the first argument +!! +public :: FS_ERROR, FS_ERROR_CODE ! CPU clock ticks storage integer, parameter, private :: TICKS = int64 @@ -770,4 +777,30 @@ 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) 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 + + state = state_type(STDLIB_FS_ERROR, "code -", to_string(code)//",",a1,a2,a3,a4,a5,a6,a7,a8, & + a9,a10,a11,a12,a13,a14,a15,a16,a17,a18) +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 + end module stdlib_system From e182803f31bec67c9ce7cbb37ed7188e94103536 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Sat, 12 Jul 2025 17:41:29 +0530 Subject: [PATCH 2/8] added tests --- test/system/test_filesystem.f90 | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index 4cf1690e4..305bc7824 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -1,6 +1,6 @@ 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_system, only: is_directory, delete_file, FS_ERROR, FS_ERROR_CODE use stdlib_error, only: state_type 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,24 @@ 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%message == msg, "FS_ERROR: Could not construct message 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%message == msg, "FS_ERROR: Could not construct message 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 From 5197a0c442f2a29f1f4a1eacf3de8d94179869ac Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Sat, 12 Jul 2025 18:03:36 +0530 Subject: [PATCH 3/8] update test --- test/system/test_filesystem.f90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index 305bc7824..73e3849b4 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, FS_ERROR, FS_ERROR_CODE - use stdlib_error, only: state_type + use stdlib_error, only: state_type, STDLIB_FS_ERROR implicit none @@ -30,13 +30,15 @@ subroutine test_FS_ERROR(error) 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%message == msg, "FS_ERROR: Could not construct message with code correctly") + call check(error, s1%state == STDLIB_FS_ERROR .and. s1%message == msg, & + "FS_ERROR: 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%message == msg, "FS_ERROR: Could not construct message without code correctly") + 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 From 2c473546f8e89237e378ee4fd0623b0c0126b6b0 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Thu, 17 Jul 2025 00:59:14 +0530 Subject: [PATCH 4/8] snake case names --- src/stdlib_system.F90 | 17 +++++++++++------ test/system/test_filesystem.f90 | 16 ++++++++-------- 2 files changed, 19 insertions(+), 14 deletions(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 37729cb96..c85820cde 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -137,9 +137,14 @@ module stdlib_system !! version: experimental !! !! A helper function for returning the `type(state_type)` with the flag `STDLIB_FS_ERROR` set. -!! `FS_ERROR_CODE` also prefixes the `code` passed to it as the first argument !! -public :: FS_ERROR, FS_ERROR_CODE +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 +!! +public :: fs_error_code ! CPU clock ticks storage integer, parameter, private :: TICKS = int64 @@ -777,7 +782,7 @@ 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, & +pure function fs_error_code(code,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10, & a11,a12,a13,a14,a15,a16,a17,a18) result(state) type(state_type) :: state @@ -789,9 +794,9 @@ pure function FS_ERROR_CODE(code,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10, & state = state_type(STDLIB_FS_ERROR, "code -", to_string(code)//",",a1,a2,a3,a4,a5,a6,a7,a8, & a9,a10,a11,a12,a13,a14,a15,a16,a17,a18) -end function FS_ERROR_CODE +end function fs_error_code -pure function FS_ERROR(a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11, & +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 @@ -801,6 +806,6 @@ pure function FS_ERROR(a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11, & 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 +end function fs_error end module stdlib_system diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index 73e3849b4..9f4115bc5 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -1,6 +1,6 @@ module test_filesystem use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test - use stdlib_system, only: is_directory, delete_file, FS_ERROR, FS_ERROR_CODE + 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,7 +13,7 @@ subroutine collect_suite(testsuite) type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & - new_unittest("FS_ERROR", test_FS_ERROR), & + 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), & @@ -22,25 +22,25 @@ subroutine collect_suite(testsuite) ] end subroutine collect_suite - subroutine test_FS_ERROR(error) + 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") + 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: Could not construct the state with code correctly") + "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") + 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") + "fs_error: Could not construct state without code correctly") if (allocated(error)) return - end subroutine test_FS_ERROR + end subroutine test_fs_error ! Test `is_directory` for a directory subroutine test_is_directory_dir(error) From a9326535c41c80923b048f96f8144ffdaf659745 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Fri, 18 Jul 2025 00:48:19 +0530 Subject: [PATCH 5/8] intel compiler hack --- src/stdlib_system.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index c85820cde..47b57bbc6 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -792,7 +792,11 @@ pure function fs_error_code(code,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10, & class(*), intent(in), optional, dimension(..) :: a1,a2,a3,a4,a5,a6,a7,a8,a9,a10, & a11,a12,a13,a14,a15,a16,a17,a18 - state = state_type(STDLIB_FS_ERROR, "code -", to_string(code)//",",a1,a2,a3,a4,a5,a6,a7,a8, & + character(:), allocatable :: code_str + + code_str = to_string(code) // "," + + state = state_type(STDLIB_FS_ERROR, "code -",code_str,a1,a2,a3,a4,a5,a6,a7,a8, & a9,a10,a11,a12,a13,a14,a15,a16,a17,a18) end function fs_error_code From 96eed56a0ba4ffdd742a6f42e3491ac5d06aff14 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Fri, 18 Jul 2025 16:38:23 +0530 Subject: [PATCH 6/8] added specs --- doc/specs/stdlib_system.md | 77 ++++++++++++++++++++++++++++++++++++++ src/stdlib_system.F90 | 15 +++++--- 2 files changed, 86 insertions(+), 6 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 96eebb2e8..e5f42ac49 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -418,6 +418,83 @@ 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`, or `character` variables. Numeric variables may be provided as either scalars or rank-1 (array) inputs. + +### Behavior + +Formats all the arguments into a nice error message, utilising 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 [, a1,a2,a3,a4...... a19])` + +### Class +Pure Function + +### Arguments + +`a1,a2,a3.....a19`: They are of type `class(*), dimension(..), optional, intent(in)`. +An arbitrary list of `integer`, `real`, `complex`, or `character` variables. Numeric variables may be provided as either scalars or rank-1 (array) inputs. + +### Behavior + +Formats all the arguments into a nice error message, utilising 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/src/stdlib_system.F90 b/src/stdlib_system.F90 index 47b57bbc6..7b7b6dba5 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -137,12 +137,15 @@ module stdlib_system !! 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 @@ -783,21 +786,21 @@ subroutine delete_file(path, err) 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) result(state) + 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 + a11,a12,a13,a14,a15,a16,a17,a18, a19 - character(:), allocatable :: code_str + character(32) :: code_msg - code_str = to_string(code) // "," + write(code_msg, "('code - ', i0, ',')") code - state = state_type(STDLIB_FS_ERROR, "code -",code_str,a1,a2,a3,a4,a5,a6,a7,a8, & - a9,a10,a11,a12,a13,a14,a15,a16,a17,a18) + 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, & From 4d1e6d0ffa012b76caf136811165ffa1fb2707c7 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Fri, 18 Jul 2025 16:38:37 +0530 Subject: [PATCH 7/8] added example --- doc/specs/stdlib_system.md | 4 ++-- example/system/CMakeLists.txt | 1 + example/system/example_fs_error.f90 | 23 +++++++++++++++++++++++ 3 files changed, 26 insertions(+), 2 deletions(-) create mode 100644 example/system/example_fs_error.f90 diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index e5f42ac49..2f97904ac 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -442,7 +442,7 @@ An arbitrary list of `integer`, `real`, `complex`, or `character` variables. Num ### Behavior -Formats all the arguments into a nice error message, utilising the constructor of [[stdlib_system(module):state_type(type)]] +Formats all the arguments into a nice error message, utilizing the constructor of [[stdlib_system(module):state_type(type)]] ### Return values @@ -481,7 +481,7 @@ An arbitrary list of `integer`, `real`, `complex`, or `character` variables. Num ### Behavior -Formats all the arguments into a nice error message, utilising the constructor of [[stdlib_system(module):state_type(type)]] +Formats all the arguments into a nice error message, utilizing the constructor of [[stdlib_system(module):state_type(type)]] ### Return values diff --git a/example/system/CMakeLists.txt b/example/system/CMakeLists.txt index a2a7525c9..9cdec1649 100644 --- a/example/system/CMakeLists.txt +++ b/example/system/CMakeLists.txt @@ -11,3 +11,4 @@ ADD_EXAMPLE(process_5) ADD_EXAMPLE(process_6) ADD_EXAMPLE(process_7) ADD_EXAMPLE(sleep) +ADD_EXAMPLE(fs_error) diff --git a/example/system/example_fs_error.f90 b/example/system/example_fs_error.f90 new file mode 100644 index 000000000..b57b43ae5 --- /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 From 03c76c98b3aa7616926e89ee2dfe4f2b2b770879 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Sun, 20 Jul 2025 13:08:28 +0530 Subject: [PATCH 8/8] capitalize functions + some doc changes --- doc/specs/stdlib_system.md | 18 +++++++++-------- example/system/example_fs_error.f90 | 8 ++++---- src/stdlib_system.F90 | 30 ++++++++++++++--------------- test/system/test_filesystem.f90 | 12 ++++++------ 4 files changed, 35 insertions(+), 33 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 2f97904ac..500c5b7a1 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -418,7 +418,7 @@ Returns one of the `integer` `OS_*` parameters representing the OS type, from th --- -## `fs_error` - Helper function for error handling +## `FS_ERROR` - Helper function for error handling ### Status @@ -430,15 +430,15 @@ A helper function for returning the `type(state_type)` with the flag `STDLIB_FS_ ### Syntax -`err = fs_error([a1,a2,a3,a4...... a20])` +`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`, or `character` variables. Numeric variables may be provided as either scalars or rank-1 (array) inputs. +`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 @@ -456,7 +456,7 @@ Formats all the arguments into a nice error message, utilizing the constructor o --- -## `fs_error_code` - Helper function for error handling (with error code) +## `FS_ERROR_CODE` - Helper function for error handling (with error code) ### Status @@ -469,15 +469,17 @@ It also formats and prefixes the `code` passed to it as the first argument. ### Syntax -`err = fs_error(code [, a1,a2,a3,a4...... a19])` +`err = FS_ERROR_CODE(code [, a1,a2,a3,a4...... a19])` ### Class Pure Function ### Arguments -`a1,a2,a3.....a19`: They are of type `class(*), dimension(..), optional, intent(in)`. -An arbitrary list of `integer`, `real`, `complex`, or `character` variables. Numeric variables may be provided as either scalars or rank-1 (array) inputs. +`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 diff --git a/example/system/example_fs_error.f90 b/example/system/example_fs_error.f90 index b57b43ae5..29ad3e213 100644 --- a/example/system/example_fs_error.f90 +++ b/example/system/example_fs_error.f90 @@ -1,19 +1,19 @@ -! Demonstrate usage of `fs_error`, `fs_error_code` +! Demonstrate usage of `FS_ERROR`, `FS_ERROR_CODE` program example_fs_error - use stdlib_system, only: fs_error, fs_error_code + 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") + 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") + 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 diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 7b7b6dba5..c97ddd764 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -137,17 +137,17 @@ module stdlib_system !! 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)) +!! ([Specification](../page/specs/stdlib_system.html#FS_ERROR)) !! -public :: 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)) +!! ([Specification](../page/specs/stdlib_system.html#FS_ERROR_CODE)) !! -public :: fs_error_code +public :: FS_ERROR_CODE ! CPU clock ticks storage integer, parameter, private :: TICKS = int64 @@ -785,34 +785,34 @@ 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) +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 + 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 + 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, & +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, & + 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, & + 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 +end function FS_ERROR end module stdlib_system diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index 9f4115bc5..838ced263 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -1,6 +1,6 @@ module test_filesystem use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test - use stdlib_system, only: is_directory, delete_file, fs_error, fs_error_code + 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,7 +13,7 @@ subroutine collect_suite(testsuite) type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & - new_unittest("fs_error", test_FS_ERROR), & + 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), & @@ -28,17 +28,17 @@ subroutine test_fs_error(error) 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") + 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") + "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") + 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") + "FS_ERROR: Could not construct state without code correctly") if (allocated(error)) return end subroutine test_fs_error