stdlib_system: essential path functionality

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. It is an `intent(in)` argument.
+    or
+`p`: Shall be a list of character strings. `intent(in)` argument.
+
+### Return values
+
+The resultant path.
+
+## `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, `intent(in)`.
+
+`rval`: A character string, `intent(in)`.
+
+### Result value
+
+The result is an `allocatable` character string
+
+#### 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 containing the path to be split. `intent(in)`
+`head`: The first part of the path. `allocatable, intent(out)`
+`tail`: The rest part of the path. `allocatable, intent(out)`
+
+### Behavior
+
+- If `p` is empty, `head` is set to `.` and `tail` is empty
+- If `p` consists entirely of path-separators. `head` is set to the path-separator and `tail` is empty
+- `head` ends in 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, `intent(in)`
+
+### Behavior
+
+- The `tail` of `stdlib_system(module):split_path(interface)` is exactly what is returned. Same Behavior.
+
+### Return values
+
+A character string.
+
+### 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, `intent(in)`
+
+### Behavior
+
+- The `head` of `stdlib_system(module):split_path(interface)` is exactly what is returned. Same Behavior.
+
+### Return values
+
+A character string.
+
+### Example
+
+```fortran
+{!example/system/example_path_dir_name.f90!}
+```

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)

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

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

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

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

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

src/stdlib_system.F90

@@ -83,7 +83,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 +558,87 @@ 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(p1, p2) result(path)
+        character(:), allocatable :: path
+        character(*), intent(in) :: p1, p2
+    end function join2
+
+    module function joinarr(p) result(path)
+        character(:), allocatable :: path
+        character(*), intent(in) :: p(:)
+    end function joinarr
+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(p1, p2) result(path)
+        character(:), allocatable :: path
+        character(*), intent(in) :: p1, p2
+    end function join_op
+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(p, head, tail)
+        character(*), intent(in) :: p
+        character(:), allocatable, intent(out) :: head, tail
+    end subroutine split_path
+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(p) result(base)
+        character(:), allocatable :: base
+        character(*), intent(in) :: p
+    end function base_name
+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(p) result(base)
+        character(:), allocatable :: base
+        character(*), intent(in) :: p
+    end function dir_name
+end interface dir_name
+
+
 contains
 
 integer function get_runtime_os() result(os)
@@ -770,4 +859,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

src/stdlib_system_path.f90

@@ -0,0 +1,82 @@
+submodule(stdlib_system) stdlib_system_path
+    use stdlib_ascii, only: reverse
+    use stdlib_strings, only: chomp, find, join
+contains
+    module function join2(p1, p2) result(path)
+        character(:), allocatable :: path
+        character(*), intent(in) :: p1, p2
+
+        path = trim(p1) // path_sep() // trim(p2)
+    end function join2
+
+    module function joinarr(p) result(path)
+        character(:), allocatable :: path
+        character(*), intent(in) :: p(:)
+
+        path = join(p, path_sep())
+    end function joinarr
+
+    module function join_op(p1, p2) result(path)
+        character(:), allocatable :: path
+        character(*), intent(in) :: p1, p2
+
+        path = join_path(p1, p2)
+    end function join_op
+
+    module subroutine split_path(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
+
+    module function base_name(p) result(base)
+        character(:), allocatable :: base, temp
+        character(*), intent(in) :: p
+
+        call split_path(p, temp, base)
+    end function base_name
+
+    module function dir_name(p) result(dir)
+        character(:), allocatable :: dir, temp
+        character(*), intent(in) :: p
+
+        call split_path(p, dir, temp)
+    end function dir_name
+end submodule stdlib_system_path

test/system/CMakeLists.txt

@@ -2,3 +2,4 @@ ADDTEST(filesystem)
 ADDTEST(os)
 ADDTEST(sleep)
 ADDTEST(subprocess)
+ADDTEST(path)

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