diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 95a7f8e41..b86f05997 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -978,3 +978,79 @@ A character string or `type(string_type)`. ```fortran {!example/system/example_path_dir_name.f90!} ``` + +--- + +## `is_abs` - Checks if the path is absolute + +### Status + +Experimental + +### Description + +This function checks if the path is absolute (i.e not relative). +- On POSIX systems this means the path starts with `/`. +- On Windows systems this means the path is either an UNC path (like `\\host\path\share`) or +a path starting with a drive letter (like `C:\Users\`) + +### Syntax + +`res = ` [[stdlib_system(module):is_abs(interface)]]`(p)` + +### Class + +Function + +### Arguments + +`p`: the path, a character string or `type(string_type)`. It is an `intent(in)` argument. + + +### Return values + +A `logical` indicating if the the path is absolute. + +### Example + +```fortran +{!example/system/example_path_abs.f90!} +``` + +--- + +## `abs_path` - Returns the absolute path + +### Status + +Experimental + +### Description + +This function returns the absolutized version of the provided path. + +### Syntax + +`res = ` [[stdlib_system(module):abs_path(interface)]]`(p [, err])` + +### Class + +Function + +### Arguments + +`p`: the path, a character string or `type(string_type)`. It is an `intent(in)` argument. + +`err`(optional): Shall be of type `state_type`, and is used for error handling. It is an `optional, intent(out)` argument. + +### Return values + +`res`: the absolutized version of the path, It is of type `character(:), allocatable`. + +`err`: It is an optional state return flag. On error if not requested, an `FS_ERROR` will trigger an error stop. + +### Example + +```fortran +{!example/system/example_path_abs.f90!} +``` diff --git a/example/system/CMakeLists.txt b/example/system/CMakeLists.txt index 3ede9e3cf..56114691b 100644 --- a/example/system/CMakeLists.txt +++ b/example/system/CMakeLists.txt @@ -16,6 +16,7 @@ ADD_EXAMPLE(path_join) ADD_EXAMPLE(path_split_path) ADD_EXAMPLE(path_base_name) ADD_EXAMPLE(path_dir_name) +ADD_EXAMPLE(path_abs) ADD_EXAMPLE(make_directory) ADD_EXAMPLE(remove_directory) ADD_EXAMPLE(cwd) diff --git a/example/system/example_path_abs.f90 b/example/system/example_path_abs.f90 new file mode 100644 index 000000000..77ef80cb7 --- /dev/null +++ b/example/system/example_path_abs.f90 @@ -0,0 +1,29 @@ +! Illustrate the usage of `abs_path`, `is_abs` +program example_path_abs + use stdlib_system, only: abs_path, is_abs + use stdlib_error, only: state_type + implicit none + + character(*), parameter :: path = "path/to/check" + character(:), allocatable :: absolute_path + type(state_type) :: err + + if (is_abs(path)) then + print *, "Path is absolute!" + ! terminate the program since path is already absolute + stop + else + print *, "Path is not absolute!" + end if + + ! get the absolute path + absolute_path = abs_path(path, err) + + if (err%error()) then + ! there was an error! print it + print *, "error converting to absolute path: " // err%print() + else + print *, "absolute path => " // absolute_path + end if +end program example_path_abs + diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 90e61e05b..5659a983f 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -93,6 +93,8 @@ module stdlib_system public :: split_path public :: base_name public :: dir_name +public :: is_abs +public :: abs_path !! version: experimental !! @@ -781,6 +783,46 @@ module function dir_name_string(p) result(dir) end function dir_name_string end interface dir_name +interface is_abs + !! version: experimental + !! + !!### Summary + !! This function checks if the path is absolute. + !! ([Specification](../page/specs/stdlib_system.html#is_abs)) + !! + !!### Description + !! This function checks if the path is absolute (i.e not relative). + !! - On POSIX systems this means the path starts with `/`. + !! - On Windows systems this means the path is either an UNC path (like `\\host\path\share`) or + !! a path starting with a drive letter (like `C:\Users\`) + module logical function is_abs_char(p) + character(len=*), intent(in) :: p + end function is_abs_char + + module logical function is_abs_string(p) + type(string_type), intent(in) :: p + end function is_abs_string +end interface is_abs + +interface abs_path + !! version: experimental + !! + !!### Summary + !! This function returns the absolutized version of the provided path. + !! ([Specification](../page/specs/stdlib_system.html#abs_path)) + !! + module function abs_path_char(p, err) result(abs_p) + character(len=*), intent(in) :: p + type(state_type), optional, intent(out) :: err + character(len=:), allocatable :: abs_p + end function abs_path_char + + module function abs_path_string(p, err) result(abs_p) + type(string_type), intent(in) :: p + type(state_type), optional, intent(out) :: err + type(string_type) :: abs_p + end function abs_path_string +end interface abs_path contains diff --git a/src/stdlib_system_path.f90 b/src/stdlib_system_path.f90 index 5ec7ef8c8..bbe9ebb0f 100644 --- a/src/stdlib_system_path.f90 +++ b/src/stdlib_system_path.f90 @@ -1,6 +1,6 @@ submodule(stdlib_system) stdlib_system_path use stdlib_ascii, only: reverse - use stdlib_strings, only: chomp, join + use stdlib_strings, only: chomp, join, starts_with use stdlib_string_type, only: string_type, char, move contains module function join2_char_char(p1, p2) result(path) @@ -167,4 +167,58 @@ module function dir_name_string(p) result(dir) call split_path(p, dir, temp) end function dir_name_string + + module logical function is_abs_char(p) + character(len=*), intent(in) :: p + character(len=1) :: sep + + sep = path_sep() + + if (sep == '/') then + ! should start with '/' + is_abs_char = starts_with(p, sep) + else + ! should be either an UNC path like '\\server\host...' + ! or should be starting with a drive letter like 'C:\Users\...' + is_abs_char = starts_with(p(2:), ':\') .or. starts_with(p, '\\') + end if + end function is_abs_char + + module logical function is_abs_string(p) + type(string_type), intent(in) :: p + + is_abs_string = is_abs(char(p)) + end function is_abs_string + + module function abs_path_char(p, err) result(abs_p) + character(len=*), intent(in) :: p + type(state_type), optional, intent(out) :: err + character(len=:), allocatable :: abs_p + + type(state_type) :: err0 + character(:), allocatable :: cwd + + ! get the current working directory + call get_cwd(cwd, err0) + + if (err0%error()) then + abs_p = '' + call err0%handle(err) + end if + + ! join the cwd and path + abs_p = cwd / p + end function abs_path_char + + module function abs_path_string(p, err) result(abs_p) + type(string_type), intent(in) :: p + type(state_type), optional, intent(out) :: err + type(string_type) :: abs_p + + character(len=:), allocatable :: res + + res = abs_path(char(p), err) + + call move(res, abs_p) + end function abs_path_string end submodule stdlib_system_path diff --git a/test/system/test_path.f90 b/test/system/test_path.f90 index 8d892b928..f74511948 100644 --- a/test/system/test_path.f90 +++ b/test/system/test_path.f90 @@ -1,6 +1,8 @@ module test_path use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test - use stdlib_system, only: join_path, operator(/), split_path, OS_TYPE, OS_WINDOWS + use stdlib_system, only: join_path, operator(/), split_path, OS_TYPE, OS_WINDOWS, & + is_abs, abs_path, get_cwd + use stdlib_error, only: state_type implicit none contains !> Collect all exported unit tests @@ -11,7 +13,9 @@ subroutine collect_suite(testsuite) testsuite = [ & new_unittest('test_join_path', test_join_path), & new_unittest('test_join_path_operator', test_join_path_op), & - new_unittest('test_split_path', test_split_path) & + new_unittest('test_split_path', test_split_path), & + new_unittest('test_is_abs', test_is_abs), & + new_unittest('test_abs_path', test_abs_path) & ] end subroutine collect_suite @@ -118,6 +122,101 @@ subroutine test_split_path(error) end if end subroutine test_split_path + subroutine test_is_abs(error) + type(error_type), allocatable, intent(out) :: error + character(:), allocatable :: p + logical :: res + + character(*), parameter :: msg = "is_abs: " + + if (OS_TYPE() == OS_WINDOWS) then + p = '.' + res = is_abs(p) + call check(error, .not. res, msg // p // " returns incorrect result") + if (allocated(error)) return + + p = '..' + res = is_abs(p) + call check(error, .not. res, msg // p // " returns incorrect result") + if (allocated(error)) return + + p = 'C:\Windows' + res = is_abs(p) + call check(error, res, msg // p // " returns incorrect result") + if (allocated(error)) return + + ! a relative path pointing to the `Windows` folder + ! in the current working directory in the drive C + p = 'C:Windows' + res = is_abs(p) + call check(error, .not. res, msg // p // " returns incorrect result") + if (allocated(error)) return + + ! UNC paths + p = '\\server_name\share_name\path' + res = is_abs(p) + call check(error, res, msg // p // " returns incorrect result") + if (allocated(error)) return + else + p = '.' + res = is_abs(p) + call check(error, .not. res, msg // p // " returns incorrect result") + if (allocated(error)) return + + p = '..' + res = is_abs(p) + call check(error, .not. res, msg // p // " returns incorrect result") + if (allocated(error)) return + + p = '/' + res = is_abs(p) + call check(error, res, msg // p // " returns incorrect result") + if (allocated(error)) return + + p = '/home/Alice' + res = is_abs(p) + call check(error, res, msg // p // " returns incorrect result") + if (allocated(error)) return + + p = './home/Alice' + res = is_abs(p) + call check(error, .not. res, msg // p // " returns incorrect result") + if (allocated(error)) return + end if + end subroutine test_is_abs + + subroutine test_abs_path(error) + type(error_type), allocatable, intent(out) :: error + character(:), allocatable :: rel_path, absolute_path, cwd, absolute_path0 + type(state_type) :: err + + if (OS_TYPE() == OS_WINDOWS) then + rel_path = ".\Folder\File" + else + rel_path = "./Folder/File" + end if + + absolute_path = abs_path(rel_path, err) + + call check(error, err%ok(), "Could not get absolute path: " // err%print()) + if (allocated(error)) return + + call check(error, is_abs(absolute_path), "absolute path created is not absolute") + if (allocated(error)) return + + call get_cwd(cwd, err) + + ! ideally shouldn't error out but just in case it does + call check(error, err%ok(), "Could not get CWD: " // err%print()) + if (allocated(error)) return + + absolute_path0 = cwd / rel_path + + call check(error, absolute_path == absolute_path0, "absolute path != (CWD / relative path)" & + // "absolute_path: " // absolute_path // " and (CWD / relative path): " // absolute_path0) + if (allocated(error)) return + end subroutine test_abs_path + end module test_path program tester