diff --git a/CMakeLists.txt b/CMakeLists.txt index f14326533..f19d3a9a8 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -31,6 +31,12 @@ if(CMAKE_Fortran_COMPILER_ID STREQUAL GNU AND CMAKE_Fortran_COMPILER_VERSION VER message(FATAL_ERROR "GCC Version 9 or newer required") endif() +# Convert CMAKE_SYSTEM_NAME to uppercase +string(TOUPPER "${CMAKE_SYSTEM_NAME}" SYSTEM_NAME_UPPER) + +# Pass the uppercase system name as a macro +add_compile_options(-D${SYSTEM_NAME_UPPER}) + # --- compiler feature checks include(CheckFortranSourceCompiles) include(CheckFortranSourceRuns) diff --git a/config/fypp_deployment.py b/config/fypp_deployment.py index aa44b1df0..204ee57c5 100644 --- a/config/fypp_deployment.py +++ b/config/fypp_deployment.py @@ -1,4 +1,5 @@ import os +import platform import fypp import argparse from joblib import Parallel, delayed @@ -115,6 +116,7 @@ def fpm_build(args,unknown): for idx, arg in enumerate(unknown): if arg.startswith("--flag"): flags= flags + unknown[idx+1] + flags = flags + "-D{}".format(platform.system().upper()) #========================================== # build with fpm subprocess.run("fpm build"+ diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 96eebb2e8..e0668934b 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. 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!} +``` 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..de5cd33d3 --- /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, ISWIN + character(len=:), allocatable :: p1 + + if( ISWIN ) 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..c8ba1290e --- /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, ISWIN + character(len=:), allocatable :: p1, head, tail + + if( ISWIN ) 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..c7c171a9d --- /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(/), ISWIN + character(len=:), allocatable :: p1, p2, p3 + character(len=20) :: parr(4) + + if( ISWIN ) 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..b79ccf1cb --- /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, ISWIN + character(len=:), allocatable :: p1, head, tail + + if( ISWIN ) 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..3cf299360 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -83,7 +83,22 @@ module stdlib_system public :: kill public :: elapsed public :: is_windows - + +!! Public path related functions and interfaces +#ifdef WINDOWS + character(len=1), parameter, public :: pathsep = '\' + logical, parameter, public :: ISWIN = .true. +#else + character(len=1), parameter, public :: pathsep = '/' + logical, parameter, public :: ISWIN = .false. +#endif + +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 +565,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 pure function join2(p1, p2) result(path) + character(:), allocatable :: path + character(*), intent(in) :: p1, p2 + end function join2 + + module pure 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 pure 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) diff --git a/src/stdlib_system_path.f90 b/src/stdlib_system_path.f90 new file mode 100644 index 000000000..2dff040a7 --- /dev/null +++ b/src/stdlib_system_path.f90 @@ -0,0 +1,80 @@ +submodule(stdlib_system) stdlib_system_path + use stdlib_ascii, only: reverse + use stdlib_strings, only: chomp, find, join +contains + module pure function join2(p1, p2) result(path) + character(:), allocatable :: path + character(*), intent(in) :: p1, p2 + + path = trim(p1) // pathsep // trim(p2) + end function join2 + + module pure function joinarr(p) result(path) + character(:), allocatable :: path + character(*), intent(in) :: p(:) + + path = join(p, pathsep) + end function joinarr + + module pure 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 + + ! Empty string, return (.,'') + if (trim(p) == '') then + head = '.' + tail = '' + return + end if + + ! Remove trailing path separators + temp = trim(chomp(trim(p), pathsep)) + + if (temp == '') then + head = pathsep + tail = '' + return + end if + + i = find(reverse(temp), pathsep) + + ! if no `pathsep`, then it probably was a root dir like `C:\` + if (i == 0) then + head = temp // pathsep + tail = '' + return + end if + + head = temp(:len(temp)-i) + + ! child of a root directory + if (find(head, pathsep) == 0) then + head = head // pathsep + 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 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..f5c04eadf --- /dev/null +++ b/test/system/test_path.f90 @@ -0,0 +1,145 @@ +module test_path + use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test + use stdlib_system, only: join_path, operator(/), split_path, ISWIN + 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 (ISWIN) 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 + 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 (ISWIN) 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 (ISWIN) 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