diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 96eebb2e8..c01788656 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -174,7 +174,7 @@ The result is a real value representing the elapsed time in seconds, measured fr ### Syntax -`delta_t = ` [[stdlib_system(module):elapsed(subroutine)]] `(process)` +`delta_t = ` [[stdlib_system(module):elapsed(interface)]] `(process)` ### Arguments @@ -212,7 +212,7 @@ in case of process hang or delay. ### Syntax -`call ` [[stdlib_system(module):wait(subroutine)]] `(process [, max_wait_time])` +`call ` [[stdlib_system(module):wait(interface)]] `(process [, max_wait_time])` ### Arguments @@ -243,7 +243,7 @@ This is especially useful for monitoring asynchronous processes and retrieving t ### Syntax -`call ` [[stdlib_system(module):update(subroutine)]] `(process)` +`call ` [[stdlib_system(module):update(interface)]] `(process)` ### Arguments @@ -269,7 +269,7 @@ This interface is useful when a process needs to be forcefully stopped, for exam ### Syntax -`call ` [[stdlib_system(module):kill(subroutine)]] `(process, success)` +`call ` [[stdlib_system(module):kill(interface)]] `(process, success)` ### Arguments @@ -298,7 +298,7 @@ It ensures that the requested sleep duration is honored on both Windows and Unix ### Syntax -`call ` [[stdlib_system(module):sleep(subroutine)]] `(millisec)` +`call ` [[stdlib_system(module):sleep(interface)]] `(millisec)` ### Arguments @@ -324,7 +324,7 @@ This function is highly efficient and works during the compilation phase, avoidi ### Syntax -`result = ` [[stdlib_system(module):is_windows(function)]] `()` +`result = ` [[stdlib_system(module):is_windows(interface)]] `()` ### Return Value @@ -359,7 +359,7 @@ If the OS cannot be identified, the function returns `OS_UNKNOWN`. ### Syntax -`os = [[stdlib_system(module):get_runtime_os(function)]]()` +`os = ` [[stdlib_system(module):get_runtime_os(function)]] `()` ### Class @@ -396,7 +396,7 @@ This caching mechanism ensures negligible overhead for repeated calls, unlike `g ### Syntax -`os = [[stdlib_system(module):OS_TYPE(function)]]()` +`os = ` [[stdlib_system(module):OS_TYPE(function)]]`()` ### Class @@ -431,7 +431,7 @@ It is designed to work across multiple platforms. On Windows, paths with both fo ### Syntax -`result = [[stdlib_system(module):is_directory(function)]] (path)` +`result = ` [[stdlib_system(module):is_directory(function)]]`(path)` ### Class @@ -471,7 +471,7 @@ It reads as an empty file. The null device's path varies by operating system: ### Syntax -`path = [[stdlib_system(module):null_device(function)]]()` +`path = ` [[stdlib_system(module):null_device(function)]]`()` ### Class @@ -506,7 +506,7 @@ The function provides an optional error-handling mechanism via the `state_type` ### Syntax -`call [[stdlib_system(module):delete_file(subroutine)]] (path [, err])` +`call ` [[stdlib_system(module):delete_file(subroutine)]]` (path [, err])` ### Class Subroutine @@ -532,3 +532,175 @@ The file is removed from the filesystem if the operation is successful. If the o ```fortran {!example/system/example_delete_file.f90!} ``` + +## `join_path` - Joins the provided paths according to the OS + +### Status + +Experimental + +### Description + +This interface joins the paths provided to it according to the platform specific path-separator. +i.e `\` for windows and `/` for others + +### Syntax + +`res = ` [[stdlib_system(module):join_path(interface)]] ` (p1, p2)` + +`res = ` [[stdlib_system(module):join_path(interface)]] ` (p)` + +### Class +Pure function + +### Arguments + +`p1, p2`: Shall be a character string or `type(string_type)`. It is an `intent(in)` argument. + or +`p`: Shall be a list of character strings or list of `type(string_type)`. It is an `intent(in)` argument. + +### Return values + +The resultant path, either a character string or `type(string_type)`. + +## `operator(/)` + +Alternative syntax to`join_path` using an overloaded operator. Join two paths according to the platform specific path-separator. + +### Status + +Experimental + +### Syntax + +`p = lval / rval` + +### Class + +Pure function. + +### Arguments + +`lval`: A character string or `type(string_type)`. It is an `intent(in)` argument. + +`rval`: A character string or `type(string_type)`. It is an `intent(in)` argument. + +### Result value + +The result is an `allocatable` character string or `type(string_type)` + +#### Example + +```fortran +{!example/system/example_path_join.f90!} +``` + +## `split_path` - splits a path immediately following the last separator + +### Status + +Experimental + +### Description + +This subroutine splits a path immediately following the last separator after removing the trailing separators +splitting it into most of the times a directory and a file name. + +### Syntax + +`call `[[stdlib_system(module):split_path(interface)]]`(p, head, tail)` + +### Class +Subroutine + +### Arguments + +`p`: A character string or `type(string_type)` containing the path to be split. It is an `intent(in)` argument. +`head`: The first part of the path. Either a character string or `type(string_type)`. It is an `intent(out)` argument. +`tail`: The rest part of the path. Either a character string or `type(string_type)`. It is an `intent(out)` argument. + +### Behavior + +- If `p` is empty, `head` is set to `.` and `tail` is left empty. +- If `p` consists entirely of path-separators, `head` is set to the path-separator and `tail` is left empty. +- `head` ends with a path-separator if and only if `p` appears to be a root directory or child of one. + +### Return values + +The splitted path. `head` and `tail`. + +### Example + +```fortran +{!example/system/example_path_split_path.f90!} +``` + +## `base_name` - The last part of a path + +### Status + +Experimental + +### Description + +This function returns the last part of a path after removing trailing path separators. + +### Syntax + +`res = ` [[stdlib_system(module):base_name(interface)]]`(p)` + +### Class +Function + +### Arguments + +`p`: the path, a character string or `type(string_type)`. It is an `intent(in)` argument. + +### Behavior + +- The `tail` of `[[stdlib_system(module):split_path(interface)]]` is exactly what is returned. Same Behavior. + +### Return values + +A character string or `type(string_type)`. + +### Example + +```fortran +{!example/system/example_path_base_name.f90!} +``` + +## `dir_name` - Everything except the last part of the path + +### Status + +Experimental + +### Description + +This function returns everything except the last part of a path. + +### Syntax + +`res = ` [[stdlib_system(module):dir_name(interface)]]`(p)` + +### Class +Function + +### Arguments + +`p`: the path, a character string or `type(string_type)`. It is an `intent(in)` argument. + +### Behavior + +- The `head` of `[[stdlib_system(module):split_path(interface)]]` is exactly what is returned. Same Behavior. + +### Return values + +A character string or `type(string_type)`. + +### Example + +```fortran +{!example/system/example_path_dir_name.f90!} +``` diff --git a/example/system/CMakeLists.txt b/example/system/CMakeLists.txt index a2a7525c9..079379c70 100644 --- a/example/system/CMakeLists.txt +++ b/example/system/CMakeLists.txt @@ -11,3 +11,7 @@ ADD_EXAMPLE(process_5) ADD_EXAMPLE(process_6) ADD_EXAMPLE(process_7) ADD_EXAMPLE(sleep) +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_path_base_name.f90 b/example/system/example_path_base_name.f90 new file mode 100644 index 000000000..0e5f46cb1 --- /dev/null +++ b/example/system/example_path_base_name.f90 @@ -0,0 +1,16 @@ +! Usage of base_name +program example_path_base_name + use stdlib_system, only: base_name, OS_TYPE, OS_WINDOWS + character(len=:), allocatable :: p1 + + if(OS_TYPE() == OS_WINDOWS) then + p1 = 'C:\Users' + else + p1 = '/home' + endif + + print *, 'base name of '// p1 // ' -> ' // base_name(p1) + ! base name of C:\Users -> Users + ! OR + ! base name of /home -> home +end program example_path_base_name diff --git a/example/system/example_path_dir_name.f90 b/example/system/example_path_dir_name.f90 new file mode 100644 index 000000000..aff61077b --- /dev/null +++ b/example/system/example_path_dir_name.f90 @@ -0,0 +1,16 @@ +! Usage of dir_name +program example_path_dir_name + use stdlib_system, only: dir_name, OS_TYPE, OS_WINDOWS + character(len=:), allocatable :: p1, head, tail + + if(OS_TYPE() == OS_WINDOWS) then + p1 = 'C:\Users' ! C:\Users + else + p1 = '/home' ! /home + endif + + print *, 'dir_name of '// p1 // ' -> ' // dir_name(p1) + ! dir_name of C:\Users -> C:\ + ! OR + ! dir_name of /home -> / +end program example_path_dir_name diff --git a/example/system/example_path_join.f90 b/example/system/example_path_join.f90 new file mode 100644 index 000000000..cdeb24a90 --- /dev/null +++ b/example/system/example_path_join.f90 @@ -0,0 +1,23 @@ +! Usage of join_path, operator(/) +program example_path_join + use stdlib_system, only: join_path, operator(/), OS_TYPE, OS_WINDOWS + character(len=:), allocatable :: p1, p2, p3 + character(len=20) :: parr(4) + + if(OS_TYPE() == OS_WINDOWS) then + p1 = 'C:'/'Users'/'User1'/'Desktop' + p2 = join_path('C:\Users\User1', 'Desktop') + parr = [character(len=20) :: 'C:', 'Users', 'User1', 'Desktop'] + p3 = join_path(parr) + else + p1 = ''/'home'/'User1'/'Desktop' + p2 = join_path('/home/User1', 'Desktop') + parr = [character(len=20) :: '', 'home', 'User1', 'Desktop'] + p3 = join_path(parr) + end if + + ! (p1 == p2 == p3) = '/home/User1/Desktop' OR 'C:\Users\User1\Desktop' + print *, p1 ! /home/User1/Desktop OR 'C:\Users\User1\Desktop' + print *, "p1 == p2: ", p1 == p2 ! T + print *, "p2 == p3: ", p2 == p3 ! T +end program example_path_join diff --git a/example/system/example_path_split_path.f90 b/example/system/example_path_split_path.f90 new file mode 100644 index 000000000..00054d786 --- /dev/null +++ b/example/system/example_path_split_path.f90 @@ -0,0 +1,25 @@ +! Usage of split_path +program example_path_split_path + use stdlib_system, only: join_path, split_path, OS_TYPE, OS_WINDOWS + character(len=:), allocatable :: p1, head, tail + + if(OS_TYPE() == OS_WINDOWS) then + p1 = join_path('C:\Users\User1', 'Desktop') ! C:\Users\User1\Desktop + else + p1 = join_path('/home/User1', 'Desktop') ! /home/User1/Desktop + endif + + call split_path(p1, head, tail) + ! head = /home/User1 OR C:\Users\User1, tail = Desktop + print *, p1 // " -> " // head // " + " // tail + ! C:\Users\User1\Desktop -> C:\Users\User1 + Desktop + ! OR + ! /home/User1/Desktop -> /home/User1 + Desktop + + call split_path(head, p1, tail) + ! p1 = /home OR C:\Users, tail = User1 + print *, head // " -> " // p1 // " + " // tail + ! C:\Users\User1 -> C:\Users + User1 + ! OR + ! /home/User1 -> /home + User1 +end program example_path_split_path diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index c3cd99120..3c8b83d38 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -32,14 +32,14 @@ set(fppFiles stdlib_linalg_kronecker.fypp stdlib_linalg_cross_product.fypp stdlib_linalg_eigenvalues.fypp - stdlib_linalg_solve.fypp + stdlib_linalg_solve.fypp stdlib_linalg_determinant.fypp stdlib_linalg_qr.fypp stdlib_linalg_inverse.fypp stdlib_linalg_pinv.fypp stdlib_linalg_norms.fypp stdlib_linalg_state.fypp - stdlib_linalg_svd.fypp + stdlib_linalg_svd.fypp stdlib_linalg_cholesky.fypp stdlib_linalg_schur.fypp stdlib_optval.fypp @@ -91,7 +91,6 @@ set(fppFiles # Preprocessed files to contain preprocessor directives -> .F90 set(cppFiles stdlib_linalg_constants.fypp - stdlib_linalg_blas.fypp stdlib_linalg_lapack.fypp ) @@ -116,6 +115,7 @@ set(SRC stdlib_sorting_radix_sort.f90 stdlib_system_subprocess.c stdlib_system_subprocess.F90 + stdlib_system_path.f90 stdlib_system.F90 stdlib_sparse.f90 stdlib_specialfunctions_legendre.f90 diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index a9c3e4d55..eb714b4a9 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -3,6 +3,7 @@ module stdlib_system c_f_pointer use stdlib_kinds, only: int64, dp, c_bool, c_char use stdlib_strings, only: to_c_char +use stdlib_string_type, only: string_type use stdlib_error, only: state_type, STDLIB_SUCCESS, STDLIB_FS_ERROR implicit none private @@ -83,7 +84,15 @@ module stdlib_system public :: kill public :: elapsed public :: is_windows - + +!! Public path related functions and interfaces +public :: path_sep +public :: join_path +public :: operator(/) +public :: split_path +public :: base_name +public :: dir_name + !! version: experimental !! !! Tests if a given path matches an existing directory. @@ -550,6 +559,141 @@ end function process_get_ID end interface +interface join_path + !! version: experimental + !! + !!### Summary + !! join the paths provided according to the OS-specific path-separator + !! ([Specification](../page/specs/stdlib_system.html#join_path)) + !! + module function join2_char_char(p1, p2) result(path) + character(:), allocatable :: path + character(*), intent(in) :: p1, p2 + end function join2_char_char + + module function join2_char_string(p1, p2) result(path) + character(:), allocatable :: path + character(*), intent(in) :: p1 + type(string_type), intent(in) :: p2 + end function join2_char_string + + module function join2_string_char(p1, p2) result(path) + type(string_type) :: path + type(string_type), intent(in) :: p1 + character(*), intent(in) :: p2 + end function join2_string_char + + module function join2_string_string(p1, p2) result(path) + type(string_type) :: path + type(string_type), intent(in) :: p1, p2 + end function join2_string_string + + module function joinarr_char(p) result(path) + character(:), allocatable :: path + character(*), intent(in) :: p(:) + end function joinarr_char + + module function joinarr_string(p) result(path) + type(string_type) :: path + type(string_type), intent(in) :: p(:) + end function joinarr_string +end interface join_path + +interface operator(/) + !! version: experimental + !! + !!### Summary + !! A binary operator to join the paths provided according to the OS-specific path-separator + !! ([Specification](../page/specs/stdlib_system.html#operator(/))) + !! + module function join_op_char_char(p1, p2) result(path) + character(:), allocatable :: path + character(*), intent(in) :: p1, p2 + end function join_op_char_char + + module function join_op_char_string(p1, p2) result(path) + character(:), allocatable :: path + character(*), intent(in) :: p1 + type(string_type), intent(in) :: p2 + end function join_op_char_string + + module function join_op_string_char(p1, p2) result(path) + type(string_type) :: path + type(string_type), intent(in) :: p1 + character(*), intent(in) :: p2 + end function join_op_string_char + + module function join_op_string_string(p1, p2) result(path) + type(string_type) :: path + type(string_type), intent(in) :: p1, p2 + end function join_op_string_string +end interface operator(/) + +interface split_path + !! version: experimental + !! + !!### Summary + !! splits the path immediately following the final path-separator + !! separating into typically a directory and a file name. + !! ([Specification](../page/specs/stdlib_system.html#split_path)) + !! + !!### Description + !! If the path is empty `head`='.' and tail='' + !! If the path only consists of separators, `head` is set to the separator and tail is empty + !! If the path is a root directory, `head` is set to that directory and tail is empty + !! `head` ends with a path-separator iff the path appears to be a root directory or a child of the root directory + module subroutine split_path_char(p, head, tail) + character(*), intent(in) :: p + character(:), allocatable, intent(out) :: head, tail + end subroutine split_path_char + + module subroutine split_path_string(p, head, tail) + type(string_type), intent(in) :: p + type(string_type), intent(out) :: head, tail + end subroutine split_path_string +end interface split_path + +interface base_name + !! version: experimental + !! + !!### Summary + !! returns the base name (last component) of the provided path + !! ([Specification](../page/specs/stdlib_system.html#base_name)) + !! + !!### Description + !! The value returned is the `tail` of the interface `split_path` + module function base_name_char(p) result(base) + character(:), allocatable :: base + character(*), intent(in) :: p + end function base_name_char + + module function base_name_string(p) result(base) + type(string_type) :: base + type(string_type), intent(in) :: p + end function base_name_string +end interface base_name + +interface dir_name + !! version: experimental + !! + !!### Summary + !! returns everything but the last component of the provided path + !! ([Specification](../page/specs/stdlib_system.html#dir_name)) + !! + !!### Description + !! The value returned is the `head` of the interface `split_path` + module function dir_name_char(p) result(dir) + character(:), allocatable :: dir + character(*), intent(in) :: p + end function dir_name_char + + module function dir_name_string(p) result(dir) + type(string_type) :: dir + type(string_type), intent(in) :: p + end function dir_name_string +end interface dir_name + + contains integer function get_runtime_os() result(os) @@ -770,4 +914,12 @@ subroutine delete_file(path, err) end if end subroutine delete_file +character function path_sep() + if (OS_TYPE() == OS_WINDOWS) then + path_sep = '\' + else + path_sep = '/' + end if +end function path_sep + end module stdlib_system diff --git a/src/stdlib_system_path.f90 b/src/stdlib_system_path.f90 new file mode 100644 index 000000000..c2ad1aec8 --- /dev/null +++ b/src/stdlib_system_path.f90 @@ -0,0 +1,170 @@ +submodule(stdlib_system) stdlib_system_path + use stdlib_ascii, only: reverse + use stdlib_strings, only: chomp, find, join + use stdlib_string_type, only: string_type, char, move +contains + module function join2_char_char(p1, p2) result(path) + character(:), allocatable :: path + character(*), intent(in) :: p1, p2 + + path = trim(p1) // path_sep() // trim(p2) + end function join2_char_char + + module function join2_char_string(p1, p2) result(path) + character(:), allocatable :: path + character(*), intent(in) :: p1 + type(string_type), intent(in) :: p2 + + path = join_path(p1, char(p2)) + end function join2_char_string + + module function join2_string_char(p1, p2) result(path) + type(string_type) :: path + type(string_type), intent(in) :: p1 + character(*), intent(in) :: p2 + character(:), allocatable :: join_char + + join_char = join_path(char(p1), p2) + + call move(join_char, path) + end function join2_string_char + + module function join2_string_string(p1, p2) result(path) + type(string_type) :: path + type(string_type), intent(in) :: p1, p2 + character(:), allocatable :: join_char + + join_char = join_path(char(p1), char(p2)) + + call move(join_char, path) + end function join2_string_string + + module function joinarr_char(p) result(path) + character(:), allocatable :: path + character(*), intent(in) :: p(:) + + path = join(p, path_sep()) + end function joinarr_char + + module function joinarr_string(p) result(path) + type(string_type) :: path + type(string_type), intent(in) :: p(:) + + path = join(p, path_sep()) + end function joinarr_string + + module function join_op_char_char(p1, p2) result(path) + character(:), allocatable :: path + character(*), intent(in) :: p1, p2 + + path = join_path(p1, p2) + end function join_op_char_char + + module function join_op_char_string(p1, p2) result(path) + character(:), allocatable :: path + character(*), intent(in) :: p1 + type(string_type), intent(in) :: p2 + + path = join_path(p1, p2) + end function join_op_char_string + + module function join_op_string_char(p1, p2) result(path) + type(string_type) :: path + type(string_type), intent(in) :: p1 + character(*), intent(in) :: p2 + + path = join_path(p1, p2) + end function join_op_string_char + + module function join_op_string_string(p1, p2) result(path) + type(string_type) :: path + type(string_type), intent(in) :: p1, p2 + + path = join_path(p1, p2) + end function join_op_string_string + + module subroutine split_path_char(p, head, tail) + character(*), intent(in) :: p + character(:), allocatable, intent(out) :: head, tail + character(:), allocatable :: temp + integer :: i + character(len=1) :: sep + sep = path_sep() + + ! Empty string, return (.,'') + if (trim(p) == '') then + head = '.' + tail = '' + return + end if + + ! Remove trailing path separators + temp = trim(chomp(trim(p), sep)) + + if (temp == '') then + head = sep + tail = '' + return + end if + + i = find(reverse(temp), sep) + + ! if no `pathsep`, then it probably was a root dir like `C:\` + if (i == 0) then + head = temp // sep + tail = '' + return + end if + + head = temp(:len(temp)-i) + + ! child of a root directory + if (find(head, sep) == 0) then + head = head // sep + end if + + tail = temp(len(temp)-i+2:) + end subroutine split_path_char + + module subroutine split_path_string(p, head, tail) + type(string_type), intent(in) :: p + type(string_type), intent(out) :: head, tail + + character(:), allocatable :: head_char, tail_char + + call split_path(char(p), head_char, tail_char) + + call move(head_char, head) + call move(tail_char, tail) + end subroutine split_path_string + + module function base_name_char(p) result(base) + character(:), allocatable :: base, temp + character(*), intent(in) :: p + + call split_path(p, temp, base) + end function base_name_char + + module function base_name_string(p) result(base) + type(string_type) :: base + type(string_type), intent(in) :: p + type(string_type) :: temp + + call split_path(p, temp, base) + end function base_name_string + + module function dir_name_char(p) result(dir) + character(:), allocatable :: dir, temp + character(*), intent(in) :: p + + call split_path(p, dir, temp) + end function dir_name_char + + module function dir_name_string(p) result(dir) + type(string_type) :: dir + type(string_type), intent(in) :: p + type(string_type) :: temp + + call split_path(p, dir, temp) + end function dir_name_string +end submodule stdlib_system_path diff --git a/test/system/CMakeLists.txt b/test/system/CMakeLists.txt index b7623ea83..0ab568a18 100644 --- a/test/system/CMakeLists.txt +++ b/test/system/CMakeLists.txt @@ -2,3 +2,4 @@ ADDTEST(filesystem) ADDTEST(os) ADDTEST(sleep) ADDTEST(subprocess) +ADDTEST(path) diff --git a/test/system/test_path.f90 b/test/system/test_path.f90 new file mode 100644 index 000000000..8d892b928 --- /dev/null +++ b/test/system/test_path.f90 @@ -0,0 +1,149 @@ +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 + implicit none +contains + !> Collect all exported unit tests + subroutine collect_suite(testsuite) + !> Collection of tests + type(unittest_type), allocatable, intent(out) :: 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) & + ] + end subroutine collect_suite + + subroutine checkpath(error, funcname, expected, got) + type(error_type), allocatable, intent(out) :: error + character(len=*), intent(in) :: funcname + character(len=*), intent(in) :: expected + character(len=:), allocatable :: got + character(len=:), allocatable :: message + + message = "'"//funcname//"'"//" error: Expected '"// expected // "' but got '" // got // "'" + call check(error, expected == got, message) + + end subroutine checkpath + + subroutine test_join_path(error) + type(error_type), allocatable, intent(out) :: error + character(len=:), allocatable :: path + character(len=20) :: paths(5) + + if (OS_TYPE() == OS_WINDOWS) then + path = join_path('C:\Users', 'Alice') + call checkpath(error, 'join_path', 'C:\Users\Alice', path) + if (allocated(error)) return + + paths = [character(20) :: 'C:','Users','Bob','Pictures','2025'] + path = join_path(paths) + + call checkpath(error, 'join_path', 'C:\Users\Bob\Pictures\2025', path) + if (allocated(error)) return + + path = join_path('"C:\Users\John Doe"', 'Pictures\2025') ! path with spaces + call checkpath(error, 'join_path', '"C:\Users\John Doe"\Pictures\2025', path) + if (allocated(error)) return + else + path = join_path('/home', 'Alice') + call checkpath(error, 'join_path', '/home/Alice', path) + if (allocated(error)) return + + paths = [character(20) :: '','home','Bob','Pictures','2025'] + path = join_path(paths) + + call checkpath(error, 'join_path', '/home/Bob/Pictures/2025', path) + if (allocated(error)) return + end if + end subroutine test_join_path + + !> Test the operator + subroutine test_join_path_op(error) + type(error_type), allocatable, intent(out) :: error + character(len=:), allocatable :: path + + if (OS_TYPE() == OS_WINDOWS) then + path = 'C:'/'Users'/'Alice'/'Desktop' + call checkpath(error, 'join_path operator', 'C:\Users\Alice\Desktop', path) + if (allocated(error)) return + else + path = ''/'home'/'Alice'/'.config' + call checkpath(error, 'join_path operator', '/home/Alice/.config', path) + if (allocated(error)) return + end if + end subroutine test_join_path_op + + subroutine test_split_path(error) + type(error_type), allocatable, intent(out) :: error + character(len=:), allocatable :: head, tail + + call split_path('', head, tail) + call checkpath(error, 'split_path-head', '.', head) + if (allocated(error)) return + call checkpath(error, 'split_path-tail', '', tail) + if (allocated(error)) return + + if (OS_TYPE() == OS_WINDOWS) then + call split_path('\\\\', head, tail) + call checkpath(error, 'split_path-head', '\', head) + if (allocated(error)) return + call checkpath(error, 'split_path-tail', '', tail) + if (allocated(error)) return + + call split_path('C:\', head, tail) + call checkpath(error, 'split_path-head', 'C:\', head) + if (allocated(error)) return + call checkpath(error, 'split_path-tail', '', tail) + if (allocated(error)) return + + call split_path('C:\Users\Alice\\\\\', head, tail) + call checkpath(error, 'split_path-head', 'C:\Users', head) + if (allocated(error)) return + call checkpath(error, 'split_path-tail', 'Alice', tail) + if (allocated(error)) return + else + call split_path('/////', head, tail) + call checkpath(error, 'split_path-head', '/', head) + if (allocated(error)) return + call checkpath(error, 'split_path-tail', '', tail) + if (allocated(error)) return + + call split_path('/home/Alice/foo/bar.f90///', head, tail) + call checkpath(error, 'split_path-head', '/home/Alice/foo', head) + if (allocated(error)) return + call checkpath(error, 'split_path-tail', 'bar.f90', tail) + if (allocated(error)) return + end if + end subroutine test_split_path + +end module test_path + +program tester + use, intrinsic :: iso_fortran_env, only : error_unit + use testdrive, only : run_testsuite, new_testsuite, testsuite_type + use test_path, only : collect_suite + + implicit none + + integer :: stat, is + type(testsuite_type), allocatable :: testsuites(:) + character(len=*), parameter :: fmt = '("#", *(1x, a))' + + stat = 0 + + testsuites = [ & + new_testsuite("path", collect_suite) & + ] + + do is = 1, size(testsuites) + write(error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) + end do + + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop + end if +end program tester pFad - Phonifier reborn

Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.

Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.


Alternative Proxies:

Alternative Proxy

pFad Proxy

pFad v3 Proxy

pFad v4 Proxy