From 08e489a813eb5ca4d7f7bacd590d95354e914463 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Thu, 10 Apr 2025 18:16:10 +0530 Subject: [PATCH 01/54] promote ascii pure functions to elemental --- src/stdlib_ascii.fypp | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/src/stdlib_ascii.fypp b/src/stdlib_ascii.fypp index 7e5eec963..fa062900d 100644 --- a/src/stdlib_ascii.fypp +++ b/src/stdlib_ascii.fypp @@ -107,13 +107,13 @@ module stdlib_ascii contains !> Checks whether `c` is an ASCII letter (A .. Z, a .. z). - pure logical function is_alpha(c) + elemental logical function is_alpha(c) character(len=1), intent(in) :: c !! The character to test. is_alpha = (c >= 'A' .and. c <= 'Z') .or. (c >= 'a' .and. c <= 'z') end function !> Checks whether `c` is a letter or a number (0 .. 9, a .. z, A .. Z). - pure logical function is_alphanum(c) + elemental logical function is_alphanum(c) character(len=1), intent(in) :: c !! The character to test. is_alphanum = (c >= '0' .and. c <= '9') .or. (c >= 'a' .and. c <= 'z') & .or. (c >= 'A' .and. c <= 'Z') @@ -121,13 +121,13 @@ contains !> Checks whether or not `c` is in the ASCII character set - !> i.e. in the range 0 .. 0x7F. - pure logical function is_ascii(c) + elemental logical function is_ascii(c) character(len=1), intent(in) :: c !! The character to test. is_ascii = iachar(c) <= int(z'7F') end function !> Checks whether `c` is a control character. - pure logical function is_control(c) + elemental logical function is_control(c) character(len=1), intent(in) :: c !! The character to test. integer :: ic ic = iachar(c) @@ -135,19 +135,19 @@ contains end function !> Checks whether `c` is a digit (0 .. 9). - pure logical function is_digit(c) + elemental logical function is_digit(c) character(len=1), intent(in) :: c !! The character to test. is_digit = ('0' <= c) .and. (c <= '9') end function !> Checks whether `c` is a digit in base 8 (0 .. 7). - pure logical function is_octal_digit(c) + elemental logical function is_octal_digit(c) character(len=1), intent(in) :: c !! The character to test. is_octal_digit = (c >= '0') .and. (c <= '7'); end function !> Checks whether `c` is a digit in base 16 (0 .. 9, A .. F, a .. f). - pure logical function is_hex_digit(c) + elemental logical function is_hex_digit(c) character(len=1), intent(in) :: c !! The character to test. is_hex_digit = (c >= '0' .and. c <= '9') .or. (c >= 'a' .and. c <= 'f') & .or. (c >= 'A' .and. c <= 'F') @@ -156,7 +156,7 @@ contains !> Checks whether or not `c` is a punctuation character. That includes !> all ASCII characters which are not control characters, letters, !> digits, or whitespace. - pure logical function is_punctuation(c) + elemental logical function is_punctuation(c) character(len=1), intent(in) :: c !! The character to test. integer :: ic ic = iachar(c) ! '~' '!' @@ -166,7 +166,7 @@ contains !> Checks whether or not `c` is a printable character other than the !> space character. - pure logical function is_graphical(c) + elemental logical function is_graphical(c) character(len=1), intent(in) :: c !! The character to test. integer :: ic ic = iachar(c) @@ -177,7 +177,7 @@ contains !> Checks whether or not `c` is a printable character - including the !> space character. - pure logical function is_printable(c) + elemental logical function is_printable(c) character(len=1), intent(in) :: c !! The character to test. integer :: ic ic = iachar(c) @@ -186,7 +186,7 @@ contains end function !> Checks whether `c` is a lowercase ASCII letter (a .. z). - pure logical function is_lower(c) + elemental logical function is_lower(c) character(len=1), intent(in) :: c !! The character to test. integer :: ic ic = iachar(c) @@ -194,7 +194,7 @@ contains end function !> Checks whether `c` is an uppercase ASCII letter (A .. Z). - pure logical function is_upper(c) + elemental logical function is_upper(c) character(len=1), intent(in) :: c !! The character to test. is_upper = (c >= 'A') .and. (c <= 'Z') end function @@ -202,7 +202,7 @@ contains !> Checks whether or not `c` is a whitespace character. That includes the !> space, tab, vertical tab, form feed, carriage return, and linefeed !> characters. - pure logical function is_white(c) + elemental logical function is_white(c) character(len=1), intent(in) :: c !! The character to test. integer :: ic ic = iachar(c) ! TAB, LF, VT, FF, CR @@ -211,7 +211,7 @@ contains !> Checks whether or not `c` is a blank character. That includes the !> only the space and tab characters - pure logical function is_blank(c) + elemental logical function is_blank(c) character(len=1), intent(in) :: c !! The character to test. integer :: ic ic = iachar(c) ! TAB From bb48f0957423490a7f6b57d89e1d16d48916365c Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Thu, 10 Apr 2025 18:16:32 +0530 Subject: [PATCH 02/54] remove unused procedure in the test --- test/ascii/test_ascii.f90 | 60 --------------------------------------- 1 file changed, 60 deletions(-) diff --git a/test/ascii/test_ascii.f90 b/test/ascii/test_ascii.f90 index 5a8878632..edf81656d 100644 --- a/test/ascii/test_ascii.f90 +++ b/test/ascii/test_ascii.f90 @@ -721,66 +721,6 @@ subroutine test_to_upper_long(error) end do end subroutine - ! - ! This test reproduces the true/false table found at - ! https://en.cppreference.com/w/cpp/string/byte - ! - subroutine test_ascii_table - integer :: i, j - logical :: table(15,12) - - abstract interface - pure logical function validation_func_interface(c) - character(len=1), intent(in) :: c - end function - end interface - - type :: proc_pointer_array - procedure(validation_func_interface), pointer, nopass :: pcf - end type proc_pointer_array - - type(proc_pointer_array) :: pcfs(12) - - pcfs(1)%pcf => is_control - pcfs(2)%pcf => is_printable - pcfs(3)%pcf => is_white - pcfs(4)%pcf => is_blank - pcfs(5)%pcf => is_graphical - pcfs(6)%pcf => is_punctuation - pcfs(7)%pcf => is_alphanum - pcfs(8)%pcf => is_alpha - pcfs(9)%pcf => is_upper - pcfs(10)%pcf => is_lower - pcfs(11)%pcf => is_digit - pcfs(12)%pcf => is_hex_digit - - ! loop through functions - do i = 1, 12 - table(1,i) = all([(pcfs(i)%pcf(achar(j)),j=0,8)]) ! control codes - table(2,i) = pcfs(i)%pcf(achar(9)) ! tab - table(3,i) = all([(pcfs(i)%pcf(achar(j)),j=10,13)]) ! whitespaces - table(4,i) = all([(pcfs(i)%pcf(achar(j)),j=14,31)]) ! control codes - table(5,i) = pcfs(i)%pcf(achar(32)) ! space - table(6,i) = all([(pcfs(i)%pcf(achar(j)),j=33,47)]) ! !"#$%&'()*+,-./ - table(7,i) = all([(pcfs(i)%pcf(achar(j)),j=48,57)]) ! 0123456789 - table(8,i) = all([(pcfs(i)%pcf(achar(j)),j=58,64)]) ! :;<=>?@ - table(9,i) = all([(pcfs(i)%pcf(achar(j)),j=65,70)]) ! ABCDEF - table(10,i) = all([(pcfs(i)%pcf(achar(j)),j=71,90)]) ! GHIJKLMNOPQRSTUVWXYZ - table(11,i) = all([(pcfs(i)%pcf(achar(j)),j=91,96)]) ! [\]^_` - table(12,i) = all([(pcfs(i)%pcf(achar(j)),j=97,102)]) ! abcdef - table(13,i) = all([(pcfs(i)%pcf(achar(j)),j=103,122)]) ! ghijklmnopqrstuvwxyz - table(14,i) = all([(pcfs(i)%pcf(achar(j)),j=123,126)]) ! {|}~ - table(15,i) = pcfs(i)%pcf(achar(127)) ! backspace character - end do - - ! output table for verification - write(*,'(5X,12(I4))') (i,i=1,12) - do j = 1, 15 - write(*,'(I3,2X,12(L4),2X,I3)') j, (table(j,i),i=1,12), count(table(j,:)) - end do - write(*,'(5X,12(I4))') (count(table(:,i)),i=1,12) - end subroutine test_ascii_table - subroutine test_to_lower_string(error) !> Error handling type(error_type), allocatable, intent(out) :: error From 32b7bf38958a1cd2e61d9d48beb1b83c0d593f10 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 10 Apr 2025 18:30:22 +0200 Subject: [PATCH 03/54] refactor ascii validation test --- test/ascii/test_ascii.f90 | 61 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) diff --git a/test/ascii/test_ascii.f90 b/test/ascii/test_ascii.f90 index edf81656d..e6584c7fe 100644 --- a/test/ascii/test_ascii.f90 +++ b/test/ascii/test_ascii.f90 @@ -721,6 +721,67 @@ subroutine test_to_upper_long(error) end do end subroutine + ! + ! This test reproduces the true/false table found at + ! https://en.cppreference.com/w/cpp/string/byte + ! + subroutine test_ascii_table + integer :: i, j + logical :: table(15,12) + + ! loop through functions + do i = 1, 12 + table(1,i) = all([(validate(j,i), j=0,8)]) + table(2,i) = validate(9,i) + table(3,i) = all([(validate(j,i), j=10,13)]) + table(4,i) = all([(validate(j,i), j=14,31)]) + table(5,i) = validate(32,i) + table(6,i) = all([(validate(j,i), j=33,47)]) + table(7,i) = all([(validate(j,i), j=48,57)]) + table(8,i) = all([(validate(j,i), j=58,64)]) + table(9,i) = all([(validate(j,i), j=65,70)]) + table(10,i) = all([(validate(j,i), j=71,90)]) + table(11,i) = all([(validate(j,i), j=91,96)]) + table(12,i) = all([(validate(j,i), j=97,102)]) + table(13,i) = all([(validate(j,i), j=103,122)]) + table(14,i) = all([(validate(j,i), j=123,126)]) + table(15,i) = validate(127,i) + end do + + ! output table for verification + write(*,'(5X,12(I4))') (i,i=1,12) + do j = 1, 15 + write(*,'(I3,2X,12(L4),2X,I3)') j, (table(j,i),i=1,12), count(table(j,:)) + end do + write(*,'(5X,12(I4))') (count(table(:,i)),i=1,12) + + contains + + elemental logical function validate(ascii_code, func) + integer, intent(in) :: ascii_code, func + character(len=1) :: c + + c = achar(ascii_code) + + select case (func) + case (1); validate = is_control(c) + case (2); validate = is_printable(c) + case (3); validate = is_white(c) + case (4); validate = is_blank(c) + case (5); validate = is_graphical(c) + case (6); validate = is_punctuation(c) + case (7); validate = is_alphanum(c) + case (8); validate = is_alpha(c) + case (9); validate = is_upper(c) + case (10); validate = is_lower(c) + case (11); validate = is_digit(c) + case (12); validate = is_hex_digit(c) + case default; validate = .false. + end select + end function validate + + end subroutine test_ascii_table + subroutine test_to_lower_string(error) !> Error handling type(error_type), allocatable, intent(out) :: error From 7e44eeac2d1c79e68e34f4c5bb2c67e71d22554e Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Fri, 11 Apr 2025 10:43:52 +0530 Subject: [PATCH 04/54] add ascii_table to the tests --- test/ascii/test_ascii.f90 | 33 +++++++++++++++++++++++++++++++-- 1 file changed, 31 insertions(+), 2 deletions(-) diff --git a/test/ascii/test_ascii.f90 b/test/ascii/test_ascii.f90 index e6584c7fe..7ff80f25b 100644 --- a/test/ascii/test_ascii.f90 +++ b/test/ascii/test_ascii.f90 @@ -52,6 +52,7 @@ subroutine collect_ascii(testsuite) new_unittest("to_lower_long", test_to_lower_long), & new_unittest("to_upper_short", test_to_upper_short), & new_unittest("to_upper_long", test_to_upper_long), & + new_unittest("ascii_table", test_ascii_table), & new_unittest("to_upper_string", test_to_upper_string), & new_unittest("to_lower_string", test_to_lower_string), & new_unittest("to_title_string", test_to_title_string), & @@ -725,9 +726,9 @@ subroutine test_to_upper_long(error) ! This test reproduces the true/false table found at ! https://en.cppreference.com/w/cpp/string/byte ! - subroutine test_ascii_table + subroutine ascii_table(table) + logical, intent(out) :: table(15,12) integer :: i, j - logical :: table(15,12) ! loop through functions do i = 1, 12 @@ -780,6 +781,34 @@ elemental logical function validate(ascii_code, func) end select end function validate + end subroutine ascii_table + + subroutine test_ascii_table(error) + type(error_type), allocatable, intent(out) :: error + logical :: arr(15, 12) + logical, parameter :: ascii_class_table(15,12) = transpose(reshape([ & + ! iscntrl isprint isspace isblank isgraph ispunct isalnum isalpha isupper islower isdigit isxdigit + .true., .false., .false., .false., .false., .false., .false., .false., .false., .false., .false., .false., & ! 0–8 + .true., .false., .true., .true., .false., .false., .false., .false., .false., .false., .false., .false., & ! 9 + .true., .false., .true., .false., .false., .false., .false., .false., .false., .false., .false., .false., & ! 10–13 + .true., .false., .false., .false., .false., .false., .false., .false., .false., .false., .false., .false., & ! 14–31 + .false., .true., .true., .true., .false., .false., .false., .false., .false., .false., .false., .false., & ! 32 (space) + .false., .true., .false., .false., .true., .true., .false., .false., .false., .false., .false., .false., & ! 33–47 + .false., .true., .false., .false., .true., .false., .true., .false., .false., .false., .true., .true., & ! 48–57 + .false., .true., .false., .false., .true., .true., .false., .false., .false., .false., .false., .false., & ! 58–64 + .false., .true., .false., .false., .true., .false., .true., .true., .true., .false., .false., .true., & ! 65–70 + .false., .true., .false., .false., .true., .false., .true., .true., .true., .false., .false., .false., & ! 71–90 + .false., .true., .false., .false., .true., .true., .false., .false., .false., .false., .false., .false., & ! 91–96 + .false., .true., .false., .false., .true., .false., .true., .true., .false., .true., .false., .true., & ! 97–102 + .false., .true., .false., .false., .true., .false., .true., .true., .false., .true., .false., .false., & ! 103–122 + .false., .true., .false., .false., .true., .true., .false., .false., .false., .false., .false., .false., & ! 123–126 + .true., .false., .false., .false., .false., .false., .false., .false., .false., .false., .false., .false. & ! 127 + ], shape=[12,15])) + + call ascii_table(arr) + call check(error, all(arr .eqv. ascii_class_table), "ascii table was not accurately generated") + + if (allocated(error)) return end subroutine test_ascii_table subroutine test_to_lower_string(error) From c580881a69b0efc6ceeaf2254d5d83c7ba83eaa9 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 11 Apr 2025 08:18:04 +0200 Subject: [PATCH 05/54] Update test/ascii/test_ascii.f90 --- test/ascii/test_ascii.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/test/ascii/test_ascii.f90 b/test/ascii/test_ascii.f90 index 7ff80f25b..94b11d6ee 100644 --- a/test/ascii/test_ascii.f90 +++ b/test/ascii/test_ascii.f90 @@ -808,7 +808,6 @@ subroutine test_ascii_table(error) call ascii_table(arr) call check(error, all(arr .eqv. ascii_class_table), "ascii table was not accurately generated") - if (allocated(error)) return end subroutine test_ascii_table subroutine test_to_lower_string(error) From 4bc022d9244cbf5438b602b69113be5097341461 Mon Sep 17 00:00:00 2001 From: Jose Alves Date: Wed, 16 Apr 2025 22:26:10 +0200 Subject: [PATCH 06/54] refactor test --- test/ascii/test_ascii.f90 | 100 +++++++++++++++----------------------- 1 file changed, 40 insertions(+), 60 deletions(-) diff --git a/test/ascii/test_ascii.f90 b/test/ascii/test_ascii.f90 index 94b11d6ee..57c27e2a5 100644 --- a/test/ascii/test_ascii.f90 +++ b/test/ascii/test_ascii.f90 @@ -726,66 +726,10 @@ subroutine test_to_upper_long(error) ! This test reproduces the true/false table found at ! https://en.cppreference.com/w/cpp/string/byte ! - subroutine ascii_table(table) - logical, intent(out) :: table(15,12) - integer :: i, j - - ! loop through functions - do i = 1, 12 - table(1,i) = all([(validate(j,i), j=0,8)]) - table(2,i) = validate(9,i) - table(3,i) = all([(validate(j,i), j=10,13)]) - table(4,i) = all([(validate(j,i), j=14,31)]) - table(5,i) = validate(32,i) - table(6,i) = all([(validate(j,i), j=33,47)]) - table(7,i) = all([(validate(j,i), j=48,57)]) - table(8,i) = all([(validate(j,i), j=58,64)]) - table(9,i) = all([(validate(j,i), j=65,70)]) - table(10,i) = all([(validate(j,i), j=71,90)]) - table(11,i) = all([(validate(j,i), j=91,96)]) - table(12,i) = all([(validate(j,i), j=97,102)]) - table(13,i) = all([(validate(j,i), j=103,122)]) - table(14,i) = all([(validate(j,i), j=123,126)]) - table(15,i) = validate(127,i) - end do - - ! output table for verification - write(*,'(5X,12(I4))') (i,i=1,12) - do j = 1, 15 - write(*,'(I3,2X,12(L4),2X,I3)') j, (table(j,i),i=1,12), count(table(j,:)) - end do - write(*,'(5X,12(I4))') (count(table(:,i)),i=1,12) - - contains - - elemental logical function validate(ascii_code, func) - integer, intent(in) :: ascii_code, func - character(len=1) :: c - - c = achar(ascii_code) - - select case (func) - case (1); validate = is_control(c) - case (2); validate = is_printable(c) - case (3); validate = is_white(c) - case (4); validate = is_blank(c) - case (5); validate = is_graphical(c) - case (6); validate = is_punctuation(c) - case (7); validate = is_alphanum(c) - case (8); validate = is_alpha(c) - case (9); validate = is_upper(c) - case (10); validate = is_lower(c) - case (11); validate = is_digit(c) - case (12); validate = is_hex_digit(c) - case default; validate = .false. - end select - end function validate - - end subroutine ascii_table - subroutine test_ascii_table(error) type(error_type), allocatable, intent(out) :: error - logical :: arr(15, 12) + integer :: i, j + logical :: table(15,12) logical, parameter :: ascii_class_table(15,12) = transpose(reshape([ & ! iscntrl isprint isspace isblank isgraph ispunct isalnum isalpha isupper islower isdigit isxdigit .true., .false., .false., .false., .false., .false., .false., .false., .false., .false., .false., .false., & ! 0–8 @@ -805,8 +749,44 @@ subroutine test_ascii_table(error) .true., .false., .false., .false., .false., .false., .false., .false., .false., .false., .false., .false. & ! 127 ], shape=[12,15])) - call ascii_table(arr) - call check(error, all(arr .eqv. ascii_class_table), "ascii table was not accurately generated") + type :: list + character(1), allocatable :: chars(:) + end type + type(list) :: tests(15) + + tests(1)%chars = [(achar(j),j=0,8)] ! control codes + tests(2)%chars = [(achar(j),j=9,9)] ! tab + tests(3)%chars = [(achar(j),j=10,13)] ! whitespaces + tests(4)%chars = [(achar(j),j=14,31)] ! control codes + tests(5)%chars = [(achar(j),j=32,32)] ! space + tests(6)%chars = [(achar(j),j=33,47)] ! !"#$%&'()*+,-./ + tests(7)%chars = [(achar(j),j=48,57)] ! 0123456789 + tests(8)%chars = [(achar(j),j=58,64)] ! :;<=>?@ + tests(9)%chars = [(achar(j),j=65,70)] ! ABCDEF + tests(10)%chars = [(achar(j),j=71,90)] ! GHIJKLMNOPQRSTUVWXYZ + tests(11)%chars = [(achar(j),j=91,96)] ! [\]^_` + tests(12)%chars = [(achar(j),j=97,102)] ! abcdef + tests(13)%chars = [(achar(j),j=103,122)]! ghijklmnopqrstuvwxyz + tests(14)%chars = [(achar(j),j=123,126)]! {|}~ + tests(15)%chars = [(achar(j),j=127,127)]! backspace character + + ! loop through functions + do i = 1, 15 + table(i,1) = all(is_control(tests(i)%chars)) + table(i,2) = all(is_printable(tests(i)%chars)) + table(i,3) = all(is_white(tests(i)%chars)) + table(i,4) = all(is_blank(tests(i)%chars)) + table(i,5) = all(is_graphical(tests(i)%chars)) + table(i,6) = all(is_punctuation(tests(i)%chars)) + table(i,7) = all(is_alphanum(tests(i)%chars)) + table(i,8) = all(is_alpha(tests(i)%chars)) + table(i,9) = all(is_upper(tests(i)%chars)) + table(i,10) = all(is_lower(tests(i)%chars)) + table(i,11) = all(is_digit(tests(i)%chars)) + table(i,12) = all(is_hex_digit(tests(i)%chars)) + end do + + call check(error, all(table .eqv. ascii_class_table), "ascii table was not accurately generated") end subroutine test_ascii_table From ddab1fb50e3dbc4570e5fd8f1780d00b0f3c0292 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Thu, 17 Apr 2025 02:24:08 +0530 Subject: [PATCH 07/54] add ascii constants docs --- doc/specs/stdlib_ascii.md | 167 +++++++++++++++++++++++++++++++++++++- 1 file changed, 166 insertions(+), 1 deletion(-) diff --git a/doc/specs/stdlib_ascii.md b/doc/specs/stdlib_ascii.md index 0bab6e8c3..97921c792 100644 --- a/doc/specs/stdlib_ascii.md +++ b/doc/specs/stdlib_ascii.md @@ -14,8 +14,173 @@ intrinsic character variables and constants. ## Constants provided by `stdlib_ascii` -@note Specification of constants is currently incomplete. +### `NUL` +Null character + +### `SOH` + +Start Of Heading Character + +### `STX` + +Start Of Text character + +### `ETX` + +End Of Text character + +### `EOT` + +End Of Transmission character + +### `ENQ` + +Enquiry character + +### `ACK` + +Acknowledge character + +### `BEL` + +Bell character + +### `BS` + +Backspace character + +### `TAB` + +Horizontal Tab character + +### `LF` + +Line Feed character + +### `VT` + +Vertical Tab character + +### `FF` + +Form Feed character + +### `CR` + +Carriage Return character + +### `SO` + +Shift Out character + +### `SI` + +Shift In character + +### `DLE` + +Data Link Escape character + +### `DC1` + +Device Control 1 character + +### `DC2` + +Device Control 2 character + +### `DC3` + +Device Control 3 character + +### `DC4` + +Device Control 4 character + +### `NAK` + +Negative Acknowledge character + +### `SYN` + +Synchronous Idle character + +### `ETB` + +End of Transmission Block character + +### `CAN` + +Cancel character + +### `EM` + +End of Medium character + +### `SUB` + +Substitute character + +### `ESC` + +Escape character + +### `FS` + +File separator character + +### `GS` + +Group Separator character + +### `RS` + +Record Separator character + +### `US` + +Unit separator character + +### `DEL` + +Delete character + +### `fullhex_digits` + +All the hexadecimal digits (0-9, A-F, a-f) + +### `hex_digits` + +All the numerical and uppercase hexadecimal digits (0-9, A-F) + +### `lowerhex_digits` + +All the numerical and lowercase hexadecimal digits (0-9, a-f) + +### `digits` + +base 10 digits (0-9) + +### `octal_digits` + +base 8 digits (0-7) + +### `letters` + +Uppercase and lowercase letters of the english alphabet (A-Z, a-z) + +### `uppercase` + +Uppercase english albhabets (A-Z) + +### `lowercase` + +Lowercase english albhabets (a-z) + +### `whitespace` + +All the ascii whitespace characters (space, horizontal tab, vertical tab, carriage return, line feed, form feed) ## Specification of the `stdlib_ascii` procedures From 11dd81e629c477635322e2bfa95d9a748d7c7802 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Fri, 18 Apr 2025 01:54:46 +0530 Subject: [PATCH 08/54] add ascii procedure docs --- doc/specs/stdlib_ascii.md | 366 +++++++++++++++++++++++++++++++++++++- 1 file changed, 364 insertions(+), 2 deletions(-) diff --git a/doc/specs/stdlib_ascii.md b/doc/specs/stdlib_ascii.md index 97921c792..9c088fbb3 100644 --- a/doc/specs/stdlib_ascii.md +++ b/doc/specs/stdlib_ascii.md @@ -184,8 +184,370 @@ All the ascii whitespace characters (space, horizontal tab, vertical tab, carria ## Specification of the `stdlib_ascii` procedures -@note Specification of procedures is currently incomplete. +### `is_alpha` +#### Status + +Experimental + +#### Description + +Checks whether input character is an ASCII letter (A-Z, a-z). + +#### Syntax + +`res =` [[stdlib_ascii(module):is_alpha(function)]] `(c)` + +#### Class + +Elemental function. + +#### Argument + +`c`: shall be an intrinsic `character(len=1)` type. It is an `intent(in)` argument. + +#### Result value + +The result is a `logical`. + +### `is_alphanum` + +#### Status + +Experimental + +#### Description + +Checks whether input character is an ASCII letter or a number (A-Z, a-z, 0-9). + +#### Syntax + +`res =` [[stdlib_ascii(module):is_alphanum(function)]] `(c)` + +#### Class + +Elemental function. + +#### Argument + +`c`: shall be an intrinsic `character(len=1)` type. It is an `intent(in)` argument. + +#### Result value + +The result is a `logical`. + +### `is_ascii` + +#### Status + +Experimental + +#### Description + +Checks whether input character is in the ASCII character set i.e in the range 0-128. + +#### Syntax + +`res =` [[stdlib_ascii(module):is_ascii(function)]] `(c)` + +#### Class + +Elemental function. + +#### Argument + +`c`: shall be an intrinsic `character(len=1)` type. It is an `intent(in)` argument. + +#### Result value + +The result is a `logical`. + +### `is_control` + +#### Status + +Experimental + +#### Description + +Checks whether input character is a control character. + +#### Syntax + +`res =` [[stdlib_ascii(module):is_control(function)]] `(c)` + +#### Class + +Elemental function. + +#### Argument + +`c`: shall be an intrinsic `character(len=1)` type. It is an `intent(in)` argument. + +#### Result value + +The result is a `logical`. + +### `is_digit` + +#### Status + +Experimental + +#### Description + +Checks whether input character is a digit (0-9). + +#### Syntax + +`res =` [[stdlib_ascii(module):is_digit(function)]] `(c)` + +#### Class + +Elemental function. + +#### Argument + +`c`: shall be an intrinsic `character(len=1)` type. It is an `intent(in)` argument. + +#### Result value + +The result is a `logical`. + +### `is_octal_digit` + +#### Status + +Experimental + +#### Description + +Checks whether input character is an octal digit (0-7) + +#### Syntax + +`res =` [[stdlib_ascii(module):is_octal_digit(function)]] `(c)` + +#### Class + +Elemental function. + +#### Argument + +`c`: shall be an intrinsic `character(len=1)` type. It is an `intent(in)` argument. + +#### Result value + +The result is a `logical`. + +### `is_hex_digit` + +#### Status + +Experimental + +#### Description + +Checks whether input character is a hexadecimal digit (0-9, A-F, a-f). + +#### Syntax + +`res =` [[stdlib_ascii(module):is_hex_digit(function)]] `(c)` + +#### Class + +Elemental function. + +#### Argument + +`c`: shall be an intrinsic `character(len=1)` type. It is an `intent(in)` argument. + +#### Result value + +The result is a `logical`. + +### `is_punctuation` + +#### Status + +Experimental + +#### Description + +Checks whether input character is a punctuation character. + +#### Syntax + +`res =` [[stdlib_ascii(module):is_punctuation(function)]] `(c)` + +#### Class + +Elemental function. + +#### Argument + +`c`: shall be an intrinsic `character(len=1)` type. It is an `intent(in)` argument. + +#### Result value + +The result is a `logical`. + +### `is_graphical` + +#### Status + +Experimental + +#### Description + +Checks whether input character is a graphical character (printable other than the space character). + +#### Syntax + +`res =` [[stdlib_ascii(module):is_graphical(function)]] `(c)` + +#### Class + +Elemental function. + +#### Argument + +`c`: shall be an intrinsic `character(len=1)` type. It is an `intent(in)` argument. + +#### Result value + +The result is a `logical`. + +### `is_printable` + +#### Status + +Experimental + +#### Description + +Checks whether input character is a printable character (including the space character). + +#### Syntax + +`res =` [[stdlib_ascii(module):is_printable(function)]] `(c)` + +#### Class + +Elemental function. + +#### Argument + +`c`: shall be an intrinsic `character(len=1)` type. It is an `intent(in)` argument. + +#### Result value + +The result is a `logical`. + +### `is_lower` + +#### Status + +Experimental + +#### Description + +Checks whether input character is a lowercase ASCII letter (a-z). + +#### Syntax + +`res =` [[stdlib_ascii(module):is_lower(function)]] `(c)` + +#### Class + +Elemental function. + +#### Argument + +`c`: shall be an intrinsic `character(len=1)` type. It is an `intent(in)` argument. + +#### Result value + +The result is a `logical`. + +### `is_upper` + +#### Status + +Experimental + +#### Description + +Checks whether input character is an uppercase ASCII letter (A-Z). + +#### Syntax + +`res =` [[stdlib_ascii(module):is_upper(function)]] `(c)` + +#### Class + +Elemental function. + +#### Argument + +`c`: shall be an intrinsic `character(len=1)` type. It is an `intent(in)` argument. + +#### Result value + +The result is a `logical`. + +### `is_white` + +#### Status + +Experimental + +#### Description + +Checks whether input character is a whitespace character (which includes space, horizontal tab, vertical tab, +carriage return, linefeed and form feed characters) + +#### Syntax + +`res =` [[stdlib_ascii(module):is_white(function)]] `(c)` + +#### Class + +Elemental function. + +#### Argument + +`c`: shall be an intrinsic `character(len=1)` type. It is an `intent(in)` argument. + +#### Result value + +The result is a `logical`. + +### `is_blank` + +#### Status + +Experimental + +#### Description + +Checks whether input character is a blank character (which includes space and tabs). + +#### Syntax + +`res =` [[stdlib_ascii(module):is_blank(function)]] `(c)` + +#### Class + +Elemental function. + +#### Argument + +`c`: shall be an intrinsic `character(len=1)` type. It is an `intent(in)` argument. + +#### Result value + +The result is a `logical`. ### `to_lower` @@ -217,7 +579,7 @@ The result is an intrinsic character type of the same length as `string`. ```fortran {!example/ascii/example_ascii_to_lower.f90!} -``` +``` ### `to_upper` From 657b312e3755e07f34d7303bbcac3d481d053d48 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Sat, 7 Jun 2025 16:01:07 +0530 Subject: [PATCH 09/54] added interfaces and necessary build stuff --- CMakeLists.txt | 6 +++ config/fypp_deployment.py | 2 + src/CMakeLists.txt | 7 +-- src/stdlib_system.F90 | 98 ++++++++++++++++++++++++++++++++++++++- 4 files changed, 109 insertions(+), 4 deletions(-) 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/src/CMakeLists.txt b/src/CMakeLists.txt index c3cd99120..5fab05667 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 @@ -94,6 +94,7 @@ set(cppFiles stdlib_linalg_blas.fypp stdlib_linalg_lapack.fypp + stdlib_system.F90 ) add_subdirectory(blas) @@ -116,7 +117,7 @@ set(SRC stdlib_sorting_radix_sort.f90 stdlib_system_subprocess.c stdlib_system_subprocess.F90 - stdlib_system.F90 + stdlib_system_path.f90 stdlib_sparse.f90 stdlib_specialfunctions_legendre.f90 stdlib_quadrature_gauss.f90 diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index a9c3e4d55..f03ae8674 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 :: joinpath +public :: operator(/) +public :: splitpath +public :: basename +public :: dirname + !! version: experimental !! !! Tests if a given path matches an existing directory. @@ -550,6 +565,87 @@ end function process_get_ID end interface +interface joinpath + !! version: experimental + !! + !!### Summary + !! join the paths provided according to the OS-specific path-separator + !! ([Specification](../page/specs/stdlib_system.html#joinpath)) + !! + 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 joinpath + +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 splitpath + !! 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#splitpath)) + !! + !!### 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 + module subroutine splitpath(p, head, tail) + character(*), intent(in) :: p + character(:), allocatable, intent(out) :: head, tail + end subroutine splitpath +end interface splitpath + +interface basename + !! version: experimental + !! + !!### Summary + !! returns the basename (last component) of the provided path + !! ([Specification](../page/specs/stdlib_system.html#basename)) + !! + !!### Description + !! The value returned is the `tail` of the interface `splitpath` + module function basename(p) result(base) + character(:), allocatable :: base + character(*), intent(in) :: p + end function basename +end interface basename + +interface dirname + !! version: experimental + !! + !!### Summary + !! returns everything but the last component of the provided path + !! ([Specification](../page/specs/stdlib_system.html#dirname)) + !! + !!### Description + !! The value returned is the `head` of the interface `splitpath` + module function dirname(p) result(base) + character(:), allocatable :: base + character(*), intent(in) :: p + end function dirname +end interface dirname + + contains integer function get_runtime_os() result(os) From f41dee4701f02361699c09f800316bb4e8c16f58 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Sat, 7 Jun 2025 16:01:43 +0530 Subject: [PATCH 10/54] implemented interfaces --- src/stdlib_system_path.f90 | 79 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 79 insertions(+) create mode 100644 src/stdlib_system_path.f90 diff --git a/src/stdlib_system_path.f90 b/src/stdlib_system_path.f90 new file mode 100644 index 000000000..8f23b88ea --- /dev/null +++ b/src/stdlib_system_path.f90 @@ -0,0 +1,79 @@ +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 = joinpath(p1, p2) + end function join_op + + module subroutine splitpath(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) + + if (head == '') then + head = pathsep + end if + + tail = temp(len(temp)-i+2:) + end subroutine splitpath + + module function basename(p) result(base) + character(:), allocatable :: base, temp + character(*), intent(in) :: p + + call splitpath(p, temp, base) + end function basename + + module function dirname(p) result(dir) + character(:), allocatable :: dir, temp + character(*), intent(in) :: p + + call splitpath(p, dir, temp) + end function dirname +end submodule stdlib_system_path From 572ad467c9264c8cc436affc42ac12e1e1cb0099 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Sat, 7 Jun 2025 16:02:12 +0530 Subject: [PATCH 11/54] example --- example/system/CMakeLists.txt | 1 + example/system/example_path_1.f90 | 41 +++++++++++++++++++++++++++++++ 2 files changed, 42 insertions(+) create mode 100644 example/system/example_path_1.f90 diff --git a/example/system/CMakeLists.txt b/example/system/CMakeLists.txt index a2a7525c9..1b16156f9 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(path_1) diff --git a/example/system/example_path_1.f90 b/example/system/example_path_1.f90 new file mode 100644 index 000000000..554eb775f --- /dev/null +++ b/example/system/example_path_1.f90 @@ -0,0 +1,41 @@ +program example_path + use stdlib_system, only: joinpath, operator(/), splitpath, ISWIN, dirname, basename + character(len=:), allocatable :: p1, p2, head, tail + character(len=20) :: parr(4) + + if (ISWIN) then + p1 = 'C:'/'Users'/'User1'/'Desktop' + parr = [character(len=20) :: 'C:', 'Users', 'User1', 'Desktop'] + p2 = joinpath(parr) + + ! p1 == p2 = 'C:\Users\User1\Desktop' + print *, p1 + print *, "p1 == p2: ", p1 == p2 + + call splitpath(p1, head, tail) + print *, p1 // " -> " // head // " + " // tail + + call splitpath(head, p1, tail) + print *, head // " -> " // p1 // " + " // tail + + print *, 'dirname of '// p1 // ' -> ' // dirname(p1) + print *, 'basename of '// p1 // ' -> ' // basename(p1) + else + p1 = ''/'home'/'User1'/'Desktop' + parr = [character(len=20) :: '', 'home', 'User1', 'Desktop'] + p2 = joinpath(parr) + + ! p1 == p2 = '/home/User1/Desktop' + print *, p1 + print *, "p1 == p2: ", p1 == p2 + + call splitpath(p1, head, tail) + print *, p1 // " -> " // head // " + " // tail + + call splitpath(head, p1, tail) + print *, head // " -> " // p1 // " + " // tail + + print *, 'dirname of '// p1 // ' -> ' // dirname(p1) + print *, 'basename of '// p1 // ' -> ' // basename(p1) + end if +end program example_path From 8a10f2693a54d5e26f3c6801a94c74682c77ca59 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Sat, 7 Jun 2025 16:02:36 +0530 Subject: [PATCH 12/54] tests added --- test/system/CMakeLists.txt | 1 + test/system/test_path.f90 | 145 +++++++++++++++++++++++++++++++++++++ 2 files changed, 146 insertions(+) create mode 100644 test/system/test_path.f90 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..3959a7dc3 --- /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: joinpath, operator(/), splitpath, 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_joinpath', test_joinpath), & + new_unittest('test_joinpath_operator', test_joinpath_op), & + new_unittest('test_splitpath', test_splitpath) & + ] + 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_joinpath(error) + type(error_type), allocatable, intent(out) :: error + character(len=:), allocatable :: path + character(len=20) :: paths(5) + + if (ISWIN) then + path = joinpath('C:\Users', 'Alice') + call checkpath(error, 'joinpath', 'C:\Users\Alice', path) + if (allocated(error)) return + + paths = [character(20) :: 'C:','Users','Bob','Pictures','2025'] + path = joinpath(paths) + + call checkpath(error, 'joinpath', 'C:\Users\Bob\Pictures\2025', path) + if (allocated(error)) return + else + path = joinpath('/home', 'Alice') + call checkpath(error, 'joinpath', '/home/Alice', path) + if (allocated(error)) return + + paths = [character(20) :: '','home','Bob','Pictures','2025'] + path = joinpath(paths) + + call checkpath(error, 'joinpath', '/home/Bob/Pictures/2025', path) + if (allocated(error)) return + end if + end subroutine test_joinpath + + !> Test the operator + subroutine test_joinpath_op(error) + type(error_type), allocatable, intent(out) :: error + character(len=:), allocatable :: path + + if (ISWIN) then + path = 'C:'/'Users'/'Alice'/'Desktop' + call checkpath(error, 'joinpath operator', 'C:\Users\Alice\Desktop', path) + if (allocated(error)) return + else + path = ''/'home'/'Alice'/'.config' + call checkpath(error, 'joinpath operator', '/home/Alice/.config', path) + if (allocated(error)) return + end if + end subroutine test_joinpath_op + + subroutine test_splitpath(error) + type(error_type), allocatable, intent(out) :: error + character(len=:), allocatable :: head, tail + + call splitpath('', head, tail) + call checkpath(error, 'splitpath-head', '.', head) + if (allocated(error)) return + call checkpath(error, 'splitpath-tail', '', tail) + if (allocated(error)) return + + if (ISWIN) then + call splitpath('\\\\', head, tail) + call checkpath(error, 'splitpath-head', '\', head) + if (allocated(error)) return + call checkpath(error, 'splitpath-tail', '', tail) + if (allocated(error)) return + + call splitpath('C:\', head, tail) + call checkpath(error, 'splitpath-head', 'C:\', head) + if (allocated(error)) return + call checkpath(error, 'splitpath-tail', '', tail) + if (allocated(error)) return + + call splitpath('C:\Users\Alice\\\\\', head, tail) + call checkpath(error, 'splitpath-head', 'C:\Users', head) + if (allocated(error)) return + call checkpath(error, 'splitpath-tail', 'Alice', tail) + if (allocated(error)) return + else + call splitpath('/////', head, tail) + call checkpath(error, 'splitpath-head', '/', head) + if (allocated(error)) return + call checkpath(error, 'splitpath-tail', '', tail) + if (allocated(error)) return + + call splitpath('/home/Alice/foo/bar.f90///', head, tail) + call checkpath(error, 'splitpath-head', '/home/Alice/foo', head) + if (allocated(error)) return + call checkpath(error, 'splitpath-tail', 'bar.f90', tail) + if (allocated(error)) return + end if + end subroutine test_splitpath + +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 From 1bd58b76f1749545058f73d39b4cb90a92a8275b Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Sat, 7 Jun 2025 16:02:50 +0530 Subject: [PATCH 13/54] added specs --- doc/specs/stdlib_system.md | 177 +++++++++++++++++++++++++++++++++++++ src/stdlib_system.F90 | 2 +- 2 files changed, 178 insertions(+), 1 deletion(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 96eebb2e8..aa6a33302 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -532,3 +532,180 @@ The file is removed from the filesystem if the operation is successful. If the o ```fortran {!example/system/example_delete_file.f90!} ``` + +## `joinpath` - 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):joinpath(interface)]] (p1, p2)` +`res = [[stdlib_system(module):joinpath(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. + +### Example + +```fortran +{!example/system/example_path_1.f90!} +``` + +## `operator(/)` + +Join two paths according to the platform specific path-separator, +Behavior exactly similar to `joinpath` + +### 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_1.f90!} +``` + +## `splitpath` - 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):splitpath(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 iff 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_1.f90!} +``` + +## `basename` - 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):basename(interface)]] (p)` + +### Class +Function + +### Arguments + +`p`: the path, a character string, `intent(in)` + +### Behavior + +- The `tail` of `stdlib_system(module):splitpath(interface)` is exactly what is returned. Same Behavior. + +### Return values + +A character string. + +### Example + +```fortran +{!example/system/example_path_1.f90!} +``` + +## `dirname` - 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):dirname(interface)]] (p)` + +### Class +Function + +### Arguments + +`p`: the path, a character string, `intent(in)` + +### Behavior + +- The `head` of `stdlib_system(module):splitpath(interface)` is exactly what is returned. Same Behavior. + +### Return values + +A character string. + +### Example + +```fortran +{!example/system/example_path_1.f90!} +``` diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index f03ae8674..34830e111 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -608,7 +608,7 @@ end function join_op !! 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 + !! `head` ends with a path-separator iff the path appears to be a root directory or a child of the root directory module subroutine splitpath(p, head, tail) character(*), intent(in) :: p character(:), allocatable, intent(out) :: head, tail From ea71960ffbcae78f5e93cae0aeff6ffabeb2a4a2 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Sun, 8 Jun 2025 13:05:10 +0530 Subject: [PATCH 14/54] an edge case handled --- src/stdlib_system_path.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/stdlib_system_path.f90 b/src/stdlib_system_path.f90 index 8f23b88ea..925feb11e 100644 --- a/src/stdlib_system_path.f90 +++ b/src/stdlib_system_path.f90 @@ -56,8 +56,9 @@ module subroutine splitpath(p, head, tail) head = temp(:len(temp)-i) - if (head == '') then - head = pathsep + ! child of a root directory + if (find(head, pathsep) == 0) then + head = head // pathsep end if tail = temp(len(temp)-i+2:) From c561108ce8c5d8f82955858057f4b38feed19a84 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Thu, 12 Jun 2025 20:41:21 +0530 Subject: [PATCH 15/54] separated examples according to OS and functions --- doc/specs/stdlib_system.md | 2 +- example/system/CMakeLists.txt | 3 ++ example/system/example_path_1.f90 | 50 ++++++----------------- example/system/example_path_1_windows.f90 | 18 ++++++++ example/system/example_path_2.f90 | 18 ++++++++ example/system/example_path_2_windows.f90 | 19 +++++++++ 6 files changed, 72 insertions(+), 38 deletions(-) create mode 100644 example/system/example_path_1_windows.f90 create mode 100644 example/system/example_path_2.f90 create mode 100644 example/system/example_path_2_windows.f90 diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index aa6a33302..cb52abf4b 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -628,7 +628,7 @@ Subroutine - 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 iff and only if `p` appears to be a root directory or child of one +- `head` ends in a path-separator if and only if `p` appears to be a root directory or child of one ### Return values diff --git a/example/system/CMakeLists.txt b/example/system/CMakeLists.txt index 1b16156f9..2844284d1 100644 --- a/example/system/CMakeLists.txt +++ b/example/system/CMakeLists.txt @@ -12,3 +12,6 @@ ADD_EXAMPLE(process_6) ADD_EXAMPLE(process_7) ADD_EXAMPLE(sleep) ADD_EXAMPLE(path_1) +ADD_EXAMPLE(path_1_windows) +ADD_EXAMPLE(path_2) +ADD_EXAMPLE(path_2_windows) diff --git a/example/system/example_path_1.f90 b/example/system/example_path_1.f90 index 554eb775f..dac79844d 100644 --- a/example/system/example_path_1.f90 +++ b/example/system/example_path_1.f90 @@ -1,41 +1,17 @@ -program example_path - use stdlib_system, only: joinpath, operator(/), splitpath, ISWIN, dirname, basename - character(len=:), allocatable :: p1, p2, head, tail +! Usage of joinpath, operator(/) +program example_join + use stdlib_system, only: joinpath, operator(/) + character(len=:), allocatable :: p1, p2, p3 character(len=20) :: parr(4) - if (ISWIN) then - p1 = 'C:'/'Users'/'User1'/'Desktop' - parr = [character(len=20) :: 'C:', 'Users', 'User1', 'Desktop'] - p2 = joinpath(parr) + p1 = ''/'home'/'User1'/'Desktop' + p2 = joinpath('/home/User1', 'Desktop') - ! p1 == p2 = 'C:\Users\User1\Desktop' - print *, p1 - print *, "p1 == p2: ", p1 == p2 + parr = [character(len=20) :: '', 'home', 'User1', 'Desktop'] + p3 = joinpath(parr) - call splitpath(p1, head, tail) - print *, p1 // " -> " // head // " + " // tail - - call splitpath(head, p1, tail) - print *, head // " -> " // p1 // " + " // tail - - print *, 'dirname of '// p1 // ' -> ' // dirname(p1) - print *, 'basename of '// p1 // ' -> ' // basename(p1) - else - p1 = ''/'home'/'User1'/'Desktop' - parr = [character(len=20) :: '', 'home', 'User1', 'Desktop'] - p2 = joinpath(parr) - - ! p1 == p2 = '/home/User1/Desktop' - print *, p1 - print *, "p1 == p2: ", p1 == p2 - - call splitpath(p1, head, tail) - print *, p1 // " -> " // head // " + " // tail - - call splitpath(head, p1, tail) - print *, head // " -> " // p1 // " + " // tail - - print *, 'dirname of '// p1 // ' -> ' // dirname(p1) - print *, 'basename of '// p1 // ' -> ' // basename(p1) - end if -end program example_path + ! (p1 == p2 == p3) = '/home/User1/Desktop' + print *, p1 ! /home/User1/Desktop + print *, "p1 == p2: ", p1 == p2 ! T + print *, "p2 == p3: ", p2 == p3 ! T +end program example_join diff --git a/example/system/example_path_1_windows.f90 b/example/system/example_path_1_windows.f90 new file mode 100644 index 000000000..e0d28dae9 --- /dev/null +++ b/example/system/example_path_1_windows.f90 @@ -0,0 +1,18 @@ +! Usage of joinpath, operator(/) +! Only Windows +program example_join_windows + use stdlib_system, only: joinpath, operator(/) + character(len=:), allocatable :: p1, p2, p3 + character(len=20) :: parr(4) + + p1 = 'C:'/'Users'/'User1'/'Desktop' + p2 = joinpath('C:\Users\User1', 'Desktop') + + parr = [character(len=20) :: 'C:', 'Users', 'User1', 'Desktop'] + p3 = joinpath(parr) + + ! (p1 == p2 == p3) = 'C:\Users\User1\Desktop' + print *, p1 ! C:\Users\User1\Desktop + print *, "p1 == p2: ", p1 == p2 ! T + print *, "p2 == p3: ", p2 == p3 ! T +end program example_join_windows diff --git a/example/system/example_path_2.f90 b/example/system/example_path_2.f90 new file mode 100644 index 000000000..4485ad503 --- /dev/null +++ b/example/system/example_path_2.f90 @@ -0,0 +1,18 @@ +! Usage of splitpath, dirname, basename +program example_splitpath + use stdlib_system, only: joinpath, splitpath, dirname, basename + character(len=:), allocatable :: p1, head, tail + + p1 = joinpath('/home/User1', 'Desktop') ! /home/User1/Desktop + + call splitpath(p1, head, tail) + ! head = /home/User1, tail = Desktop + print *, p1 // " -> " // head // " + " // tail ! /home/User1/Desktop -> /home/User1 + Desktop + + call splitpath(head, p1, tail) + ! p1 = /home, tail = User1 + print *, head // " -> " // p1 // " + " // tail ! /home/User1 -> /home + User1 + + print *, 'dirname of '// p1 // ' -> ' // dirname(p1) ! dirname of /home -> / + print *, 'basename of '// p1 // ' -> ' // basename(p1) ! basename of /home -> home +end program example_splitpath diff --git a/example/system/example_path_2_windows.f90 b/example/system/example_path_2_windows.f90 new file mode 100644 index 000000000..59b2c5a1f --- /dev/null +++ b/example/system/example_path_2_windows.f90 @@ -0,0 +1,19 @@ +! Usage of splitpath, dirname, basename +! Only Windows +program example_splitpath_windows + use stdlib_system, only: joinpath, splitpath, dirname, basename + character(len=:), allocatable :: p1, head, tail + + p1 = joinpath('C:\Users\User1', 'Desktop') ! C:\Users\User1\Desktop + + call splitpath(p1, head, tail) + ! head = C:\Users\User1, tail = Desktop + print *, p1 // " -> " // head // " + " // tail ! C:\Users\User1\Desktop -> C:\Users\User1 + Desktop + + call splitpath(head, p1, tail) + ! p1 = C:\Users, tail = User1 + print *, head // " -> " // p1 // " + " // tail ! C:\Users\User1 -> C:\Users + User1 + + print *, 'dirname of '// p1 // ' -> ' // dirname(p1) ! dirname of C:\Users -> C:\ + print *, 'basename of '// p1 // ' -> ' // basename(p1) ! basename of C:\Users -> Users +end program example_splitpath_windows From 272eb675b3df42b12812379dbdc908d0ed795fa7 Mon Sep 17 00:00:00 2001 From: jalvesz Date: Sun, 15 Jun 2025 19:59:09 +0200 Subject: [PATCH 16/54] further split examples and fix some autodoc links issues due to wrong declarations --- doc/specs/stdlib_system.md | 53 ++++++++++------------- example/system/CMakeLists.txt | 8 ++-- example/system/example_path_1.f90 | 17 -------- example/system/example_path_1_windows.f90 | 18 -------- example/system/example_path_2.f90 | 18 -------- example/system/example_path_2_windows.f90 | 19 -------- example/system/example_path_basename.f90 | 16 +++++++ example/system/example_path_dirname.f90 | 16 +++++++ example/system/example_path_join.f90 | 22 ++++++++++ example/system/example_path_splitpath.f90 | 25 +++++++++++ 10 files changed, 107 insertions(+), 105 deletions(-) delete mode 100644 example/system/example_path_1.f90 delete mode 100644 example/system/example_path_1_windows.f90 delete mode 100644 example/system/example_path_2.f90 delete mode 100644 example/system/example_path_2_windows.f90 create mode 100644 example/system/example_path_basename.f90 create mode 100644 example/system/example_path_dirname.f90 create mode 100644 example/system/example_path_join.f90 create mode 100644 example/system/example_path_splitpath.f90 diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index cb52abf4b..ed31ade0a 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 @@ -546,8 +546,9 @@ i.e `\` for windows and `/` for others ### Syntax -`res = [[stdlib_system(module):joinpath(interface)]] (p1, p2)` -`res = [[stdlib_system(module):joinpath(interface)]] (p)` +`res = ` [[stdlib_system(module):joinpath(interface)]] ` (p1, p2)` + +`res = ` [[stdlib_system(module):joinpath(interface)]] ` (p)` ### Class Pure function @@ -562,16 +563,9 @@ Pure function The resultant path. -### Example - -```fortran -{!example/system/example_path_1.f90!} -``` - ## `operator(/)` -Join two paths according to the platform specific path-separator, -Behavior exactly similar to `joinpath` +Alternative syntax to`joinpath` using an overloaded operator. Join two paths according to the platform specific path-separator. ### Status @@ -579,7 +573,7 @@ Experimental ### Syntax -`p = lval + rval` +`p = lval / rval` ### Class @@ -588,6 +582,7 @@ Pure function. ### Arguments `lval`: A character string, `intent(in)`. + `rval`: A character string, `intent(in)`. ### Result value @@ -597,7 +592,7 @@ The result is an `allocatable` character string #### Example ```fortran -{!example/system/example_path_1.f90!} +{!example/system/example_path_join.f90!} ``` ## `splitpath` - splits a path immediately following the last separator @@ -613,7 +608,7 @@ splitting it into most of the times a directory and a file name. ### Syntax -`call [[stdlib_system(module):splitpath(interface)]] (p, head, tail)` +`call `[[stdlib_system(module):splitpath(interface)]]`(p, head, tail)` ### Class Subroutine @@ -637,7 +632,7 @@ The splitted path. `head` and `tail`. ### Example ```fortran -{!example/system/example_path_1.f90!} +{!example/system/example_path_splitpath.f90!} ``` ## `basename` - The last part of a path @@ -652,7 +647,7 @@ This function returns the last part of a path after removing trailing path separ ### Syntax -`res = [[stdlib_system(module):basename(interface)]] (p)` +`res = ` [[stdlib_system(module):basename(interface)]]`(p)` ### Class Function @@ -672,7 +667,7 @@ A character string. ### Example ```fortran -{!example/system/example_path_1.f90!} +{!example/system/example_path_basename.f90!} ``` ## `dirname` - Everything except the last part of the path @@ -687,7 +682,7 @@ This function returns everything except the last part of a path. ### Syntax -`res = [[stdlib_system(module):dirname(interface)]] (p)` +`res = ` [[stdlib_system(module):dirname(interface)]]`(p)` ### Class Function @@ -707,5 +702,5 @@ A character string. ### Example ```fortran -{!example/system/example_path_1.f90!} +{!example/system/example_path_dirname.f90!} ``` diff --git a/example/system/CMakeLists.txt b/example/system/CMakeLists.txt index 2844284d1..25828ef6d 100644 --- a/example/system/CMakeLists.txt +++ b/example/system/CMakeLists.txt @@ -11,7 +11,7 @@ ADD_EXAMPLE(process_5) ADD_EXAMPLE(process_6) ADD_EXAMPLE(process_7) ADD_EXAMPLE(sleep) -ADD_EXAMPLE(path_1) -ADD_EXAMPLE(path_1_windows) -ADD_EXAMPLE(path_2) -ADD_EXAMPLE(path_2_windows) +ADD_EXAMPLE(path_basename) +ADD_EXAMPLE(path_dirname) +ADD_EXAMPLE(path_join) +ADD_EXAMPLE(path_splitpath) diff --git a/example/system/example_path_1.f90 b/example/system/example_path_1.f90 deleted file mode 100644 index dac79844d..000000000 --- a/example/system/example_path_1.f90 +++ /dev/null @@ -1,17 +0,0 @@ -! Usage of joinpath, operator(/) -program example_join - use stdlib_system, only: joinpath, operator(/) - character(len=:), allocatable :: p1, p2, p3 - character(len=20) :: parr(4) - - p1 = ''/'home'/'User1'/'Desktop' - p2 = joinpath('/home/User1', 'Desktop') - - parr = [character(len=20) :: '', 'home', 'User1', 'Desktop'] - p3 = joinpath(parr) - - ! (p1 == p2 == p3) = '/home/User1/Desktop' - print *, p1 ! /home/User1/Desktop - print *, "p1 == p2: ", p1 == p2 ! T - print *, "p2 == p3: ", p2 == p3 ! T -end program example_join diff --git a/example/system/example_path_1_windows.f90 b/example/system/example_path_1_windows.f90 deleted file mode 100644 index e0d28dae9..000000000 --- a/example/system/example_path_1_windows.f90 +++ /dev/null @@ -1,18 +0,0 @@ -! Usage of joinpath, operator(/) -! Only Windows -program example_join_windows - use stdlib_system, only: joinpath, operator(/) - character(len=:), allocatable :: p1, p2, p3 - character(len=20) :: parr(4) - - p1 = 'C:'/'Users'/'User1'/'Desktop' - p2 = joinpath('C:\Users\User1', 'Desktop') - - parr = [character(len=20) :: 'C:', 'Users', 'User1', 'Desktop'] - p3 = joinpath(parr) - - ! (p1 == p2 == p3) = 'C:\Users\User1\Desktop' - print *, p1 ! C:\Users\User1\Desktop - print *, "p1 == p2: ", p1 == p2 ! T - print *, "p2 == p3: ", p2 == p3 ! T -end program example_join_windows diff --git a/example/system/example_path_2.f90 b/example/system/example_path_2.f90 deleted file mode 100644 index 4485ad503..000000000 --- a/example/system/example_path_2.f90 +++ /dev/null @@ -1,18 +0,0 @@ -! Usage of splitpath, dirname, basename -program example_splitpath - use stdlib_system, only: joinpath, splitpath, dirname, basename - character(len=:), allocatable :: p1, head, tail - - p1 = joinpath('/home/User1', 'Desktop') ! /home/User1/Desktop - - call splitpath(p1, head, tail) - ! head = /home/User1, tail = Desktop - print *, p1 // " -> " // head // " + " // tail ! /home/User1/Desktop -> /home/User1 + Desktop - - call splitpath(head, p1, tail) - ! p1 = /home, tail = User1 - print *, head // " -> " // p1 // " + " // tail ! /home/User1 -> /home + User1 - - print *, 'dirname of '// p1 // ' -> ' // dirname(p1) ! dirname of /home -> / - print *, 'basename of '// p1 // ' -> ' // basename(p1) ! basename of /home -> home -end program example_splitpath diff --git a/example/system/example_path_2_windows.f90 b/example/system/example_path_2_windows.f90 deleted file mode 100644 index 59b2c5a1f..000000000 --- a/example/system/example_path_2_windows.f90 +++ /dev/null @@ -1,19 +0,0 @@ -! Usage of splitpath, dirname, basename -! Only Windows -program example_splitpath_windows - use stdlib_system, only: joinpath, splitpath, dirname, basename - character(len=:), allocatable :: p1, head, tail - - p1 = joinpath('C:\Users\User1', 'Desktop') ! C:\Users\User1\Desktop - - call splitpath(p1, head, tail) - ! head = C:\Users\User1, tail = Desktop - print *, p1 // " -> " // head // " + " // tail ! C:\Users\User1\Desktop -> C:\Users\User1 + Desktop - - call splitpath(head, p1, tail) - ! p1 = C:\Users, tail = User1 - print *, head // " -> " // p1 // " + " // tail ! C:\Users\User1 -> C:\Users + User1 - - print *, 'dirname of '// p1 // ' -> ' // dirname(p1) ! dirname of C:\Users -> C:\ - print *, 'basename of '// p1 // ' -> ' // basename(p1) ! basename of C:\Users -> Users -end program example_splitpath_windows diff --git a/example/system/example_path_basename.f90 b/example/system/example_path_basename.f90 new file mode 100644 index 000000000..e465e36b9 --- /dev/null +++ b/example/system/example_path_basename.f90 @@ -0,0 +1,16 @@ +! Usage of splitpath, dirname, basename +program example_path_splitpath + use stdlib_system, only: basename, ISWIN + character(len=:), allocatable :: p1 + + if( ISWIN ) then + p1 = 'C:\Users' + else + p1 = '/home' + endif + + print *, 'basename of '// p1 // ' -> ' // basename(p1) + ! basename of C:\Users -> Users + ! OR + ! basename of /home -> home +end program example_path_splitpath diff --git a/example/system/example_path_dirname.f90 b/example/system/example_path_dirname.f90 new file mode 100644 index 000000000..c922ecc0e --- /dev/null +++ b/example/system/example_path_dirname.f90 @@ -0,0 +1,16 @@ +! Usage of splitpath, dirname, basename +program example_path_splitpath + use stdlib_system, only: dirname, ISWIN + character(len=:), allocatable :: p1, head, tail + + if( ISWIN ) then + p1 = 'C:\Users' ! C:\Users + else + p1 = '/home' ! /home + endif + + print *, 'dirname of '// p1 // ' -> ' // dirname(p1) + ! dirname of C:\Users -> C:\ + ! OR + ! dirname of /home -> / +end program example_path_splitpath diff --git a/example/system/example_path_join.f90 b/example/system/example_path_join.f90 new file mode 100644 index 000000000..2fa349a26 --- /dev/null +++ b/example/system/example_path_join.f90 @@ -0,0 +1,22 @@ +! Usage of joinpath, operator(/) +program example_path_join + use stdlib_system, only: joinpath, operator(/), ISWIN + character(len=:), allocatable :: p1, p2, p3 + character(len=20) :: parr(4) + + if( ISWIN ) then + p1 = 'C:'/'Users'/'User1'/'Desktop' + p2 = joinpath('C:\Users\User1', 'Desktop') + else + p1 = ''/'home'/'User1'/'Desktop' + p2 = joinpath('/home/User1', 'Desktop') + end if + + parr = [character(len=20) :: '', 'home', 'User1', 'Desktop'] + p3 = joinpath(parr) + + ! (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_splitpath.f90 b/example/system/example_path_splitpath.f90 new file mode 100644 index 000000000..b6ddf730a --- /dev/null +++ b/example/system/example_path_splitpath.f90 @@ -0,0 +1,25 @@ +! Usage of splitpath, dirname, basename +program example_path_splitpath + use stdlib_system, only: joinpath, splitpath, ISWIN + character(len=:), allocatable :: p1, head, tail + + if( ISWIN ) then + p1 = joinpath('C:\Users\User1', 'Desktop') ! C:\Users\User1\Desktop + else + p1 = joinpath('/home/User1', 'Desktop') ! /home/User1/Desktop + endif + + call splitpath(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 splitpath(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_splitpath From 5147094f6de28d5eb1882ca0d9a54683c0426e06 Mon Sep 17 00:00:00 2001 From: jalvesz Date: Sun, 15 Jun 2025 20:24:08 +0200 Subject: [PATCH 17/54] misslocation of source file --- src/CMakeLists.txt | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 5fab05667..3c8b83d38 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -91,10 +91,8 @@ set(fppFiles # Preprocessed files to contain preprocessor directives -> .F90 set(cppFiles stdlib_linalg_constants.fypp - stdlib_linalg_blas.fypp stdlib_linalg_lapack.fypp - stdlib_system.F90 ) add_subdirectory(blas) @@ -118,6 +116,7 @@ set(SRC stdlib_system_subprocess.c stdlib_system_subprocess.F90 stdlib_system_path.f90 + stdlib_system.F90 stdlib_sparse.f90 stdlib_specialfunctions_legendre.f90 stdlib_quadrature_gauss.f90 From 9e6409407b6d5e70784bd96cb1679863b504d8b0 Mon Sep 17 00:00:00 2001 From: jalvesz Date: Sun, 15 Jun 2025 20:46:19 +0200 Subject: [PATCH 18/54] fix example program names --- example/system/example_path_basename.f90 | 6 +++--- example/system/example_path_dirname.f90 | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/example/system/example_path_basename.f90 b/example/system/example_path_basename.f90 index e465e36b9..2d7587541 100644 --- a/example/system/example_path_basename.f90 +++ b/example/system/example_path_basename.f90 @@ -1,5 +1,5 @@ -! Usage of splitpath, dirname, basename -program example_path_splitpath +! Usage of basename +program example_path_basename use stdlib_system, only: basename, ISWIN character(len=:), allocatable :: p1 @@ -13,4 +13,4 @@ program example_path_splitpath ! basename of C:\Users -> Users ! OR ! basename of /home -> home -end program example_path_splitpath +end program example_path_basename diff --git a/example/system/example_path_dirname.f90 b/example/system/example_path_dirname.f90 index c922ecc0e..493afeed3 100644 --- a/example/system/example_path_dirname.f90 +++ b/example/system/example_path_dirname.f90 @@ -1,5 +1,5 @@ -! Usage of splitpath, dirname, basename -program example_path_splitpath +! Usage of dirname +program example_path_dirname use stdlib_system, only: dirname, ISWIN character(len=:), allocatable :: p1, head, tail @@ -13,4 +13,4 @@ program example_path_splitpath ! dirname of C:\Users -> C:\ ! OR ! dirname of /home -> / -end program example_path_splitpath +end program example_path_dirname From ca867f8134ac32352f92d92c57d70b23c759e8d7 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Mon, 16 Jun 2025 01:13:59 +0530 Subject: [PATCH 19/54] fix example_path_join.f90 --- example/system/example_path_join.f90 | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/example/system/example_path_join.f90 b/example/system/example_path_join.f90 index 2fa349a26..caea4b7a5 100644 --- a/example/system/example_path_join.f90 +++ b/example/system/example_path_join.f90 @@ -7,16 +7,17 @@ program example_path_join if( ISWIN ) then p1 = 'C:'/'Users'/'User1'/'Desktop' p2 = joinpath('C:\Users\User1', 'Desktop') + parr = [character(len=20) :: 'C:', 'Users', 'User1', 'Desktop'] + p3 = joinpath(parr) else p1 = ''/'home'/'User1'/'Desktop' p2 = joinpath('/home/User1', 'Desktop') + parr = [character(len=20) :: '', 'home', 'User1', 'Desktop'] + p3 = joinpath(parr) end if - parr = [character(len=20) :: '', 'home', 'User1', 'Desktop'] - p3 = joinpath(parr) - - ! (p1 == p2 == p3) = '/home/User1/Desktop' OR 'C:'/'Users'/'User1'/'Desktop' - print *, p1 ! /home/User1/Desktop OR 'C:'/'Users'/'User1'/'Desktop' + ! (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 From 62bef00335d30a182901bde7371630cb98a92bfa Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Thu, 19 Jun 2025 23:11:42 +0530 Subject: [PATCH 20/54] Consistent naming --- doc/specs/stdlib_system.md | 30 ++++---- example/system/CMakeLists.txt | 6 +- example/system/example_path_base_name.f90 | 16 ++++ example/system/example_path_basename.f90 | 16 ---- example/system/example_path_dir_name.f90 | 16 ++++ example/system/example_path_dirname.f90 | 16 ---- example/system/example_path_join.f90 | 12 +-- ...itpath.f90 => example_path_split_path.f90} | 16 ++-- src/stdlib_system.F90 | 50 ++++++------ src/stdlib_system_path.f90 | 18 ++--- test/system/test_path.f90 | 76 +++++++++---------- 11 files changed, 136 insertions(+), 136 deletions(-) create mode 100644 example/system/example_path_base_name.f90 delete mode 100644 example/system/example_path_basename.f90 create mode 100644 example/system/example_path_dir_name.f90 delete mode 100644 example/system/example_path_dirname.f90 rename example/system/{example_path_splitpath.f90 => example_path_split_path.f90} (57%) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index ed31ade0a..e0668934b 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -533,7 +533,7 @@ The file is removed from the filesystem if the operation is successful. If the o {!example/system/example_delete_file.f90!} ``` -## `joinpath` - Joins the provided paths according to the OS +## `join_path` - Joins the provided paths according to the OS ### Status @@ -546,9 +546,9 @@ i.e `\` for windows and `/` for others ### Syntax -`res = ` [[stdlib_system(module):joinpath(interface)]] ` (p1, p2)` +`res = ` [[stdlib_system(module):join_path(interface)]] ` (p1, p2)` -`res = ` [[stdlib_system(module):joinpath(interface)]] ` (p)` +`res = ` [[stdlib_system(module):join_path(interface)]] ` (p)` ### Class Pure function @@ -565,7 +565,7 @@ The resultant path. ## `operator(/)` -Alternative syntax to`joinpath` using an overloaded operator. Join two paths according to the platform specific path-separator. +Alternative syntax to`join_path` using an overloaded operator. Join two paths according to the platform specific path-separator. ### Status @@ -595,7 +595,7 @@ The result is an `allocatable` character string {!example/system/example_path_join.f90!} ``` -## `splitpath` - splits a path immediately following the last separator +## `split_path` - splits a path immediately following the last separator ### Status @@ -608,7 +608,7 @@ splitting it into most of the times a directory and a file name. ### Syntax -`call `[[stdlib_system(module):splitpath(interface)]]`(p, head, tail)` +`call `[[stdlib_system(module):split_path(interface)]]`(p, head, tail)` ### Class Subroutine @@ -632,10 +632,10 @@ The splitted path. `head` and `tail`. ### Example ```fortran -{!example/system/example_path_splitpath.f90!} +{!example/system/example_path_split_path.f90!} ``` -## `basename` - The last part of a path +## `base_name` - The last part of a path ### Status @@ -647,7 +647,7 @@ This function returns the last part of a path after removing trailing path separ ### Syntax -`res = ` [[stdlib_system(module):basename(interface)]]`(p)` +`res = ` [[stdlib_system(module):base_name(interface)]]`(p)` ### Class Function @@ -658,7 +658,7 @@ Function ### Behavior -- The `tail` of `stdlib_system(module):splitpath(interface)` is exactly what is returned. Same Behavior. +- The `tail` of `stdlib_system(module):split_path(interface)` is exactly what is returned. Same Behavior. ### Return values @@ -667,10 +667,10 @@ A character string. ### Example ```fortran -{!example/system/example_path_basename.f90!} +{!example/system/example_path_base_name.f90!} ``` -## `dirname` - Everything except the last part of the path +## `dir_name` - Everything except the last part of the path ### Status @@ -682,7 +682,7 @@ This function returns everything except the last part of a path. ### Syntax -`res = ` [[stdlib_system(module):dirname(interface)]]`(p)` +`res = ` [[stdlib_system(module):dir_name(interface)]]`(p)` ### Class Function @@ -693,7 +693,7 @@ Function ### Behavior -- The `head` of `stdlib_system(module):splitpath(interface)` is exactly what is returned. Same Behavior. +- The `head` of `stdlib_system(module):split_path(interface)` is exactly what is returned. Same Behavior. ### Return values @@ -702,5 +702,5 @@ A character string. ### Example ```fortran -{!example/system/example_path_dirname.f90!} +{!example/system/example_path_dir_name.f90!} ``` diff --git a/example/system/CMakeLists.txt b/example/system/CMakeLists.txt index 25828ef6d..079379c70 100644 --- a/example/system/CMakeLists.txt +++ b/example/system/CMakeLists.txt @@ -11,7 +11,7 @@ ADD_EXAMPLE(process_5) ADD_EXAMPLE(process_6) ADD_EXAMPLE(process_7) ADD_EXAMPLE(sleep) -ADD_EXAMPLE(path_basename) -ADD_EXAMPLE(path_dirname) ADD_EXAMPLE(path_join) -ADD_EXAMPLE(path_splitpath) +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_basename.f90 b/example/system/example_path_basename.f90 deleted file mode 100644 index 2d7587541..000000000 --- a/example/system/example_path_basename.f90 +++ /dev/null @@ -1,16 +0,0 @@ -! Usage of basename -program example_path_basename - use stdlib_system, only: basename, ISWIN - character(len=:), allocatable :: p1 - - if( ISWIN ) then - p1 = 'C:\Users' - else - p1 = '/home' - endif - - print *, 'basename of '// p1 // ' -> ' // basename(p1) - ! basename of C:\Users -> Users - ! OR - ! basename of /home -> home -end program example_path_basename 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_dirname.f90 b/example/system/example_path_dirname.f90 deleted file mode 100644 index 493afeed3..000000000 --- a/example/system/example_path_dirname.f90 +++ /dev/null @@ -1,16 +0,0 @@ -! Usage of dirname -program example_path_dirname - use stdlib_system, only: dirname, ISWIN - character(len=:), allocatable :: p1, head, tail - - if( ISWIN ) then - p1 = 'C:\Users' ! C:\Users - else - p1 = '/home' ! /home - endif - - print *, 'dirname of '// p1 // ' -> ' // dirname(p1) - ! dirname of C:\Users -> C:\ - ! OR - ! dirname of /home -> / -end program example_path_dirname diff --git a/example/system/example_path_join.f90 b/example/system/example_path_join.f90 index caea4b7a5..c7c171a9d 100644 --- a/example/system/example_path_join.f90 +++ b/example/system/example_path_join.f90 @@ -1,19 +1,19 @@ -! Usage of joinpath, operator(/) +! Usage of join_path, operator(/) program example_path_join - use stdlib_system, only: joinpath, operator(/), ISWIN + 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 = joinpath('C:\Users\User1', 'Desktop') + p2 = join_path('C:\Users\User1', 'Desktop') parr = [character(len=20) :: 'C:', 'Users', 'User1', 'Desktop'] - p3 = joinpath(parr) + p3 = join_path(parr) else p1 = ''/'home'/'User1'/'Desktop' - p2 = joinpath('/home/User1', 'Desktop') + p2 = join_path('/home/User1', 'Desktop') parr = [character(len=20) :: '', 'home', 'User1', 'Desktop'] - p3 = joinpath(parr) + p3 = join_path(parr) end if ! (p1 == p2 == p3) = '/home/User1/Desktop' OR 'C:\Users\User1\Desktop' diff --git a/example/system/example_path_splitpath.f90 b/example/system/example_path_split_path.f90 similarity index 57% rename from example/system/example_path_splitpath.f90 rename to example/system/example_path_split_path.f90 index b6ddf730a..b79ccf1cb 100644 --- a/example/system/example_path_splitpath.f90 +++ b/example/system/example_path_split_path.f90 @@ -1,25 +1,25 @@ -! Usage of splitpath, dirname, basename -program example_path_splitpath - use stdlib_system, only: joinpath, splitpath, ISWIN +! 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 = joinpath('C:\Users\User1', 'Desktop') ! C:\Users\User1\Desktop + p1 = join_path('C:\Users\User1', 'Desktop') ! C:\Users\User1\Desktop else - p1 = joinpath('/home/User1', 'Desktop') ! /home/User1/Desktop + p1 = join_path('/home/User1', 'Desktop') ! /home/User1/Desktop endif - call splitpath(p1, head, tail) + 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 splitpath(head, p1, tail) + 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_splitpath +end program example_path_split_path diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 34830e111..3cf299360 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -93,11 +93,11 @@ module stdlib_system logical, parameter, public :: ISWIN = .false. #endif -public :: joinpath +public :: join_path public :: operator(/) -public :: splitpath -public :: basename -public :: dirname +public :: split_path +public :: base_name +public :: dir_name !! version: experimental !! @@ -565,12 +565,12 @@ end function process_get_ID end interface -interface joinpath +interface join_path !! version: experimental !! !!### Summary !! join the paths provided according to the OS-specific path-separator - !! ([Specification](../page/specs/stdlib_system.html#joinpath)) + !! ([Specification](../page/specs/stdlib_system.html#join_path)) !! module pure function join2(p1, p2) result(path) character(:), allocatable :: path @@ -581,7 +581,7 @@ module pure function joinarr(p) result(path) character(:), allocatable :: path character(*), intent(in) :: p(:) end function joinarr -end interface joinpath +end interface join_path interface operator(/) !! version: experimental @@ -596,54 +596,54 @@ module pure function join_op(p1, p2) result(path) end function join_op end interface operator(/) -interface splitpath +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#splitpath)) + !! ([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 splitpath(p, head, tail) + module subroutine split_path(p, head, tail) character(*), intent(in) :: p character(:), allocatable, intent(out) :: head, tail - end subroutine splitpath -end interface splitpath + end subroutine split_path +end interface split_path -interface basename +interface base_name !! version: experimental !! !!### Summary - !! returns the basename (last component) of the provided path - !! ([Specification](../page/specs/stdlib_system.html#basename)) + !! 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 `splitpath` - module function basename(p) result(base) + !! 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 basename -end interface basename + end function base_name +end interface base_name -interface dirname +interface dir_name !! version: experimental !! !!### Summary !! returns everything but the last component of the provided path - !! ([Specification](../page/specs/stdlib_system.html#dirname)) + !! ([Specification](../page/specs/stdlib_system.html#dir_name)) !! !!### Description - !! The value returned is the `head` of the interface `splitpath` - module function dirname(p) result(base) + !! 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 dirname -end interface dirname + end function dir_name +end interface dir_name contains diff --git a/src/stdlib_system_path.f90 b/src/stdlib_system_path.f90 index 925feb11e..2dff040a7 100644 --- a/src/stdlib_system_path.f90 +++ b/src/stdlib_system_path.f90 @@ -20,10 +20,10 @@ module pure function join_op(p1, p2) result(path) character(:), allocatable :: path character(*), intent(in) :: p1, p2 - path = joinpath(p1, p2) + path = join_path(p1, p2) end function join_op - module subroutine splitpath(p, head, tail) + module subroutine split_path(p, head, tail) character(*), intent(in) :: p character(:), allocatable, intent(out) :: head, tail character(:), allocatable :: temp @@ -62,19 +62,19 @@ module subroutine splitpath(p, head, tail) end if tail = temp(len(temp)-i+2:) - end subroutine splitpath + end subroutine split_path - module function basename(p) result(base) + module function base_name(p) result(base) character(:), allocatable :: base, temp character(*), intent(in) :: p - call splitpath(p, temp, base) - end function basename + call split_path(p, temp, base) + end function base_name - module function dirname(p) result(dir) + module function dir_name(p) result(dir) character(:), allocatable :: dir, temp character(*), intent(in) :: p - call splitpath(p, dir, temp) - end function dirname + call split_path(p, dir, temp) + end function dir_name end submodule stdlib_system_path diff --git a/test/system/test_path.f90 b/test/system/test_path.f90 index 3959a7dc3..f5c04eadf 100644 --- a/test/system/test_path.f90 +++ b/test/system/test_path.f90 @@ -1,6 +1,6 @@ module test_path use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test - use stdlib_system, only: joinpath, operator(/), splitpath, ISWIN + use stdlib_system, only: join_path, operator(/), split_path, ISWIN implicit none contains !> Collect all exported unit tests @@ -9,9 +9,9 @@ subroutine collect_suite(testsuite) type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & - new_unittest('test_joinpath', test_joinpath), & - new_unittest('test_joinpath_operator', test_joinpath_op), & - new_unittest('test_splitpath', test_splitpath) & + 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 @@ -27,92 +27,92 @@ subroutine checkpath(error, funcname, expected, got) end subroutine checkpath - subroutine test_joinpath(error) + 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 = joinpath('C:\Users', 'Alice') - call checkpath(error, 'joinpath', 'C:\Users\Alice', path) + 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 = joinpath(paths) + path = join_path(paths) - call checkpath(error, 'joinpath', 'C:\Users\Bob\Pictures\2025', path) + call checkpath(error, 'join_path', 'C:\Users\Bob\Pictures\2025', path) if (allocated(error)) return else - path = joinpath('/home', 'Alice') - call checkpath(error, 'joinpath', '/home/Alice', path) + 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 = joinpath(paths) + path = join_path(paths) - call checkpath(error, 'joinpath', '/home/Bob/Pictures/2025', path) + call checkpath(error, 'join_path', '/home/Bob/Pictures/2025', path) if (allocated(error)) return end if - end subroutine test_joinpath + end subroutine test_join_path !> Test the operator - subroutine test_joinpath_op(error) + 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, 'joinpath operator', 'C:\Users\Alice\Desktop', path) + call checkpath(error, 'join_path operator', 'C:\Users\Alice\Desktop', path) if (allocated(error)) return else path = ''/'home'/'Alice'/'.config' - call checkpath(error, 'joinpath operator', '/home/Alice/.config', path) + call checkpath(error, 'join_path operator', '/home/Alice/.config', path) if (allocated(error)) return end if - end subroutine test_joinpath_op + end subroutine test_join_path_op - subroutine test_splitpath(error) + subroutine test_split_path(error) type(error_type), allocatable, intent(out) :: error character(len=:), allocatable :: head, tail - call splitpath('', head, tail) - call checkpath(error, 'splitpath-head', '.', head) + call split_path('', head, tail) + call checkpath(error, 'split_path-head', '.', head) if (allocated(error)) return - call checkpath(error, 'splitpath-tail', '', tail) + call checkpath(error, 'split_path-tail', '', tail) if (allocated(error)) return if (ISWIN) then - call splitpath('\\\\', head, tail) - call checkpath(error, 'splitpath-head', '\', head) + call split_path('\\\\', head, tail) + call checkpath(error, 'split_path-head', '\', head) if (allocated(error)) return - call checkpath(error, 'splitpath-tail', '', tail) + call checkpath(error, 'split_path-tail', '', tail) if (allocated(error)) return - call splitpath('C:\', head, tail) - call checkpath(error, 'splitpath-head', 'C:\', head) + call split_path('C:\', head, tail) + call checkpath(error, 'split_path-head', 'C:\', head) if (allocated(error)) return - call checkpath(error, 'splitpath-tail', '', tail) + call checkpath(error, 'split_path-tail', '', tail) if (allocated(error)) return - call splitpath('C:\Users\Alice\\\\\', head, tail) - call checkpath(error, 'splitpath-head', 'C:\Users', head) + call split_path('C:\Users\Alice\\\\\', head, tail) + call checkpath(error, 'split_path-head', 'C:\Users', head) if (allocated(error)) return - call checkpath(error, 'splitpath-tail', 'Alice', tail) + call checkpath(error, 'split_path-tail', 'Alice', tail) if (allocated(error)) return else - call splitpath('/////', head, tail) - call checkpath(error, 'splitpath-head', '/', head) + call split_path('/////', head, tail) + call checkpath(error, 'split_path-head', '/', head) if (allocated(error)) return - call checkpath(error, 'splitpath-tail', '', tail) + call checkpath(error, 'split_path-tail', '', tail) if (allocated(error)) return - call splitpath('/home/Alice/foo/bar.f90///', head, tail) - call checkpath(error, 'splitpath-head', '/home/Alice/foo', head) + 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, 'splitpath-tail', 'bar.f90', tail) + call checkpath(error, 'split_path-tail', 'bar.f90', tail) if (allocated(error)) return end if - end subroutine test_splitpath + end subroutine test_split_path end module test_path From 1c87df913497b595f69a626c90198faab2f2f000 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Sat, 21 Jun 2025 16:54:44 +0530 Subject: [PATCH 21/54] windows test case for path with spaces --- test/system/test_path.f90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/test/system/test_path.f90 b/test/system/test_path.f90 index f5c04eadf..2027ead07 100644 --- a/test/system/test_path.f90 +++ b/test/system/test_path.f90 @@ -42,6 +42,10 @@ subroutine test_join_path(error) 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) From 8d00eea4291202f0f01bd67daef95aedb973e44b Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 2 Jul 2025 03:17:01 +0530 Subject: [PATCH 22/54] added functions and relevant wrappers --- src/CMakeLists.txt | 5 +- src/stdlib_system.F90 | 124 +++++++++++++++++++++++++++++++++++++++++- src/stdlib_system.c | 46 ++++++++++++++++ 3 files changed, 172 insertions(+), 3 deletions(-) create mode 100644 src/stdlib_system.c diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index c3cd99120..24fd9c56b 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 @@ -116,6 +116,7 @@ set(SRC stdlib_sorting_radix_sort.f90 stdlib_system_subprocess.c stdlib_system_subprocess.F90 + stdlib_system.c stdlib_system.F90 stdlib_sparse.f90 stdlib_specialfunctions_legendre.f90 diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index a9c3e4d55..dd83f4bbb 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 @@ -100,6 +100,36 @@ module stdlib_system !! public :: is_directory +!! version: experimental +!! +!! Makes an empty directory. +!! ([Specification](../page/specs/stdlib_system.html#make_directory)) +!! +!! ### Summary +!! Creates an empty directory with particular permissions. +!! +!! ### Description +!! This function makes an empty directory according to the path provided. +!! Relative paths as well as on Windows paths involving either `/` or `\` are accepted +!! appropriate error message is returned whenever any error occur. +!! +public :: make_directory + +!! version: experimental +!! +!! Removes an empty directory. +!! ([Specification](../page/specs/stdlib_system.html#remove_directory)) +!! +!! ### Summary +!! Deletes an empty directory. +!! +!! ### Description +!! This function deletes an empty directory according to the path provided. +!! Relative paths as well as on Windows paths involving either `/` or `\` are accepted. +!! appropriate error message is returned whenever any error occur. +!! +public :: remove_directory + !! version: experimental !! !! Deletes a specified file from the filesystem. @@ -690,6 +720,98 @@ end function stdlib_is_directory end function is_directory +function c_get_strerror() result(str) + character(len=:), allocatable :: str + + interface + type(c_ptr) function strerror(len) bind(C, name='stdlib_strerror') + import c_size_t, c_ptr, c_int + implicit none + integer(c_size_t), intent(out) :: len + end function strerror + end interface + + type(c_ptr) :: c_str_ptr + integer(c_size_t) :: len, i + character(kind=c_char), pointer :: c_str(:) + + c_str_ptr = strerror(len) + + call c_f_pointer(c_str_ptr, c_str, [len]) + + allocate(character(len=len) :: str) + + do concurrent (i=1:len) + str(i:i) = c_str(i) + end do +end function c_get_strerror + +!! makes an empty directory +subroutine make_directory(path, mode, err) + character(len=*), intent(in) :: path + integer, intent(in), optional :: mode + character, allocatable :: err_msg + type(state_type), optional, intent(out) :: err + + integer :: code + type(state_type) :: err0 + + + interface + integer function stdlib_make_directory(cpath, cmode) bind(C, name='stdlib_make_directory') + import c_char + character(kind=c_char), intent(in) :: cpath(*) + integer, intent(in) :: cmode + end function stdlib_make_directory + end interface + + if (is_windows() .and. present(mode)) then + ! _mkdir() doesn't have a `mode` argument + err0 = state_type(STDLIB_FS_ERROR, "mode argument not present for Windows") + call err0%handle(err) + return + end if + + code = stdlib_make_directory(to_c_char(trim(path)), mode) + + select case (code) + case (0) + return + case default + ! error + err0 = state_type(STDLIB_FS_ERROR, "code:", to_string(code)//',', c_get_strerror()) + call err0%handle(err) + end select +end subroutine make_directory + +!! Removes an empty directory +subroutine remove_directory(path, err) + character(len=*), intent(in) :: path + character, allocatable :: err_msg + type(state_type), optional, intent(out) :: err + + integer :: code + type(state_type) :: err0 + + interface + integer function stdlib_remove_directory(cpath) bind(C, name='stdlib_remove_directory') + import c_char + character(kind=c_char), intent(in) :: cpath(*) + end function stdlib_remove_directory + end interface + + code = stdlib_remove_directory(to_c_char(trim(path))) + + select case (code) + case (0) + return + case default + ! error + err0 = state_type(STDLIB_FS_ERROR, "code:", to_string(code)//',', c_get_strerror()) + call err0%handle(err) + end select +end subroutine remove_directory + !> Returns the file path of the null device for the current operating system. !> !> Version: Helper function. diff --git a/src/stdlib_system.c b/src/stdlib_system.c new file mode 100644 index 000000000..2d9368cc3 --- /dev/null +++ b/src/stdlib_system.c @@ -0,0 +1,46 @@ +#include +#include +#include +#include +#include +#ifdef _WIN32 +#include +#else +#include +#endif /* ifdef _WIN32 */ + +char* stdlib_strerror(size_t* len){ + char* err = strerror(errno); + *len = strlen(err); + return err; +} + +int stdlib_make_directory(const char* path, mode_t mode){ + int code; +#ifdef _WIN32 + code = _mkdir(path); +#else + code = mkdir(path, mode); +#endif /* ifdef _WIN32 */ + + if (!code){ + return 0; + } + + return errno; +} + +int stdlib_remove_directory(const char* path){ + int code; +#ifdef _WIN32 + code = _rmdir(path); +#else + code = rmdir(path); +#endif /* ifdef _WIN32 */ + + if (!code){ + return 0; + } + + return errno; +} From c9345c1e1378e9d695f803442e1d2ccd9b223610 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 2 Jul 2025 03:17:20 +0530 Subject: [PATCH 23/54] added tests --- test/system/test_filesystem.f90 | 80 ++++++++++++++++++++++++++++++++- 1 file changed, 78 insertions(+), 2 deletions(-) diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index 4cf1690e4..0f5e24ea1 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, make_directory, remove_directory use stdlib_error, only: state_type implicit none @@ -17,7 +17,11 @@ subroutine collect_suite(testsuite) new_unittest("fs_is_directory_file", test_is_directory_file), & new_unittest("fs_delete_non_existent", test_delete_file_non_existent), & new_unittest("fs_delete_existing_file", test_delete_file_existing), & - new_unittest("fs_delete_file_being_dir", test_delete_directory) & + new_unittest("fs_delete_file_being_dir", test_delete_directory), & + new_unittest("fs_make_dir", test_make_directory), & + new_unittest("fs_make_dir_existing_dir", test_make_directory_existing), & + new_unittest("fs_remove_dir", test_remove_directory), & + new_unittest("fs_remove_dir_non_existent", test_remove_directory_nonexistent) & ] end subroutine collect_suite @@ -145,7 +149,79 @@ subroutine test_delete_directory(error) if (allocated(error)) return end subroutine test_delete_directory + + subroutine test_make_directory(error) + type(error_type), allocatable, intent(out) :: error + type(state_type) :: err + character(len=256) :: filename + integer :: ios,iocmd + character(len=512) :: msg + + filename = "test_directory" + call make_directory(filename, err=err) + call check(error, err%ok(), 'Could not make directory: '//err%print()) + if (allocated(error)) return + + ! Clean up: remove the empty directory + call execute_command_line('rmdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup make_directory test: '//trim(msg)) + if (allocated(error)) return + end subroutine test_make_directory + + subroutine test_make_directory_existing(error) + type(error_type), allocatable, intent(out) :: error + type(state_type) :: err + character(len=256) :: filename + integer :: ios,iocmd + character(len=512) :: msg + + filename = "test_directory" + + call execute_command_line('mkdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call check(error, ios==0 .and. iocmd==0, 'Cannot init make_directory_existing test: '//trim(msg)) + if (allocated(error)) return + + call make_directory(filename, err=err) + call check(error, err%error(), 'Made an already existing directory somehow') + + ! Clean up: remove the empty directory + call execute_command_line('rmdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup make_directory test: '//trim(msg)) + if (allocated(error)) return + end subroutine test_make_directory_existing + + subroutine test_remove_directory(error) + type(error_type), allocatable, intent(out) :: error + type(state_type) :: err + character(len=256) :: filename + integer :: ios,iocmd + character(len=512) :: msg + + filename = "test_directory" + + call execute_command_line('mkdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call check(error, ios==0 .and. iocmd==0, 'Cannot init remove_directory test: '//trim(msg)) + if (allocated(error)) return + + call remove_directory(filename, err) + call check(error, err%ok(), 'Could not remove directory: '//err%print()) + if (allocated(error)) then + ! Clean up: remove the empty directory + call execute_command_line('rmdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup make_directory test: '//trim(msg)) + if (allocated(error)) return + end if + end subroutine test_remove_directory + + subroutine test_remove_directory_nonexistent(error) + type(error_type), allocatable, intent(out) :: error + type(state_type) :: err + + call remove_directory("random_name", err) + call check(error, err%error(), 'Somehow removed a non-existent directory!: ') + if (allocated(error)) return + end subroutine test_remove_directory_nonexistent end module test_filesystem From d94d7fb790e6bdfd431610e4befb19e7dfe1207c Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 2 Jul 2025 03:17:39 +0530 Subject: [PATCH 24/54] added specs --- doc/specs/stdlib_system.md | 76 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 76 insertions(+) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 96eebb2e8..bb5b1afa2 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -456,6 +456,82 @@ The function returns a `logical` value: --- +## `make_directory` - Creates an empty directory + +### Status + +Experimental + +### Description + +It creates an empty directory. +It is designed to work across multiple platforms. On Windows, paths with both forward `/` and backward `\` slashes are accepted. + +### Syntax + +`call [[stdlib_system(module):make_directory(subroutine)]] (path, mode, err)` + +### Class + +Subroutine + +### Arguments + +`path`: Shall be a character string containing the path of the directory to create. It is an `intent(in)` argument. + +`mode`: Shall be a scalar integer indicating the permission bits required (Not applicable to Windows). It is an `optional, intent(in)` argument. + +`err`: Shall be of type `state_type`, for error handling. It is an `optional, intent(out)` argument. + +### Return values + +The `err` is set accordingly. + +### Example + +```fortran +{!example/system/example_make_directory.f90!} +``` + +--- + +## `remove_directory` - Removes an empty directory + +### Status + +Experimental + +### Description + +It deletes an empty directory. +It is designed to work across multiple platforms. On Windows, paths with both forward `/` and backward `\` slashes are accepted. + +### Syntax + +`call [[stdlib_system(module):remove_directory(subroutine)]] (path, err)` + +### Class + +Subroutine + +### Arguments + +`path`: Shall be a character string containing the path of the directory to create. It is an `intent(in)` argument. + +`err`: Shall be of type `state_type`, for error handling. It is an `intent(out)` argument. + +### Return values + +The `err` is set accordingly. + +### Example + +```fortran +{!example/system/example_remove_directory.f90!} +``` + +--- + ## `null_device` - Return the null device file path ### Status From e1f68d833d55b0fdd141f9e1a2861ec76310200c Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 2 Jul 2025 03:18:04 +0530 Subject: [PATCH 25/54] added examples --- example/system/CMakeLists.txt | 2 ++ example/system/example_make_directory.f90 | 17 +++++++++++++++++ example/system/example_remove_directory.f90 | 17 +++++++++++++++++ 3 files changed, 36 insertions(+) create mode 100644 example/system/example_make_directory.f90 create mode 100644 example/system/example_remove_directory.f90 diff --git a/example/system/CMakeLists.txt b/example/system/CMakeLists.txt index a2a7525c9..8189d525b 100644 --- a/example/system/CMakeLists.txt +++ b/example/system/CMakeLists.txt @@ -11,3 +11,5 @@ ADD_EXAMPLE(process_5) ADD_EXAMPLE(process_6) ADD_EXAMPLE(process_7) ADD_EXAMPLE(sleep) +ADD_EXAMPLE(make_directory) +ADD_EXAMPLE(remove_directory) diff --git a/example/system/example_make_directory.f90 b/example/system/example_make_directory.f90 new file mode 100644 index 000000000..5e551b810 --- /dev/null +++ b/example/system/example_make_directory.f90 @@ -0,0 +1,17 @@ +! Illustrate the usage of make_directory +program example_make_directory + use stdlib_system, only: make_directory, is_directory + use stdlib_error, only: state_type + implicit none + + type(state_type) :: err + + call make_directory("test", err=err) + + if (err%error()) then + print *, err%print() + else + print *, "directory created sucessfully" + end if + +end program example_make_directory diff --git a/example/system/example_remove_directory.f90 b/example/system/example_remove_directory.f90 new file mode 100644 index 000000000..993adf4f9 --- /dev/null +++ b/example/system/example_remove_directory.f90 @@ -0,0 +1,17 @@ +! Illustrate the usage of remove_directory +program example_remove_directory + use stdlib_system, only: make_directory, is_directory, remove_directory + use stdlib_error, only: state_type + implicit none + + type(state_type) :: err + + call remove_directory("directory_to_be_removed", err) + + if (err%error()) then + print *, err%print() + else + print *, "directory removed successfully" + end if + +end program example_remove_directory From c3db3a65723cb3e5c45bc511d2e1ba0c567fc2d0 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 2 Jul 2025 04:01:02 +0530 Subject: [PATCH 26/54] cleanup --- src/stdlib_system.F90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index dd83f4bbb..2e0d3a1aa 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -725,7 +725,7 @@ function c_get_strerror() result(str) interface type(c_ptr) function strerror(len) bind(C, name='stdlib_strerror') - import c_size_t, c_ptr, c_int + import c_size_t, c_ptr implicit none integer(c_size_t), intent(out) :: len end function strerror @@ -750,7 +750,6 @@ end function c_get_strerror subroutine make_directory(path, mode, err) character(len=*), intent(in) :: path integer, intent(in), optional :: mode - character, allocatable :: err_msg type(state_type), optional, intent(out) :: err integer :: code @@ -787,7 +786,6 @@ end subroutine make_directory !! Removes an empty directory subroutine remove_directory(path, err) character(len=*), intent(in) :: path - character, allocatable :: err_msg type(state_type), optional, intent(out) :: err integer :: code From 3832d5e80886dd8b5b33a2082d2fc34f9bba3031 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Sat, 5 Jul 2025 20:44:42 +0530 Subject: [PATCH 27/54] Revert "refactor test" This reverts commit 4bc022d9244cbf5438b602b69113be5097341461. --- test/ascii/test_ascii.f90 | 100 +++++++++++++++++++++++--------------- 1 file changed, 60 insertions(+), 40 deletions(-) diff --git a/test/ascii/test_ascii.f90 b/test/ascii/test_ascii.f90 index 57c27e2a5..94b11d6ee 100644 --- a/test/ascii/test_ascii.f90 +++ b/test/ascii/test_ascii.f90 @@ -726,10 +726,66 @@ subroutine test_to_upper_long(error) ! This test reproduces the true/false table found at ! https://en.cppreference.com/w/cpp/string/byte ! + subroutine ascii_table(table) + logical, intent(out) :: table(15,12) + integer :: i, j + + ! loop through functions + do i = 1, 12 + table(1,i) = all([(validate(j,i), j=0,8)]) + table(2,i) = validate(9,i) + table(3,i) = all([(validate(j,i), j=10,13)]) + table(4,i) = all([(validate(j,i), j=14,31)]) + table(5,i) = validate(32,i) + table(6,i) = all([(validate(j,i), j=33,47)]) + table(7,i) = all([(validate(j,i), j=48,57)]) + table(8,i) = all([(validate(j,i), j=58,64)]) + table(9,i) = all([(validate(j,i), j=65,70)]) + table(10,i) = all([(validate(j,i), j=71,90)]) + table(11,i) = all([(validate(j,i), j=91,96)]) + table(12,i) = all([(validate(j,i), j=97,102)]) + table(13,i) = all([(validate(j,i), j=103,122)]) + table(14,i) = all([(validate(j,i), j=123,126)]) + table(15,i) = validate(127,i) + end do + + ! output table for verification + write(*,'(5X,12(I4))') (i,i=1,12) + do j = 1, 15 + write(*,'(I3,2X,12(L4),2X,I3)') j, (table(j,i),i=1,12), count(table(j,:)) + end do + write(*,'(5X,12(I4))') (count(table(:,i)),i=1,12) + + contains + + elemental logical function validate(ascii_code, func) + integer, intent(in) :: ascii_code, func + character(len=1) :: c + + c = achar(ascii_code) + + select case (func) + case (1); validate = is_control(c) + case (2); validate = is_printable(c) + case (3); validate = is_white(c) + case (4); validate = is_blank(c) + case (5); validate = is_graphical(c) + case (6); validate = is_punctuation(c) + case (7); validate = is_alphanum(c) + case (8); validate = is_alpha(c) + case (9); validate = is_upper(c) + case (10); validate = is_lower(c) + case (11); validate = is_digit(c) + case (12); validate = is_hex_digit(c) + case default; validate = .false. + end select + end function validate + + end subroutine ascii_table + subroutine test_ascii_table(error) type(error_type), allocatable, intent(out) :: error - integer :: i, j - logical :: table(15,12) + logical :: arr(15, 12) logical, parameter :: ascii_class_table(15,12) = transpose(reshape([ & ! iscntrl isprint isspace isblank isgraph ispunct isalnum isalpha isupper islower isdigit isxdigit .true., .false., .false., .false., .false., .false., .false., .false., .false., .false., .false., .false., & ! 0–8 @@ -749,44 +805,8 @@ subroutine test_ascii_table(error) .true., .false., .false., .false., .false., .false., .false., .false., .false., .false., .false., .false. & ! 127 ], shape=[12,15])) - type :: list - character(1), allocatable :: chars(:) - end type - type(list) :: tests(15) - - tests(1)%chars = [(achar(j),j=0,8)] ! control codes - tests(2)%chars = [(achar(j),j=9,9)] ! tab - tests(3)%chars = [(achar(j),j=10,13)] ! whitespaces - tests(4)%chars = [(achar(j),j=14,31)] ! control codes - tests(5)%chars = [(achar(j),j=32,32)] ! space - tests(6)%chars = [(achar(j),j=33,47)] ! !"#$%&'()*+,-./ - tests(7)%chars = [(achar(j),j=48,57)] ! 0123456789 - tests(8)%chars = [(achar(j),j=58,64)] ! :;<=>?@ - tests(9)%chars = [(achar(j),j=65,70)] ! ABCDEF - tests(10)%chars = [(achar(j),j=71,90)] ! GHIJKLMNOPQRSTUVWXYZ - tests(11)%chars = [(achar(j),j=91,96)] ! [\]^_` - tests(12)%chars = [(achar(j),j=97,102)] ! abcdef - tests(13)%chars = [(achar(j),j=103,122)]! ghijklmnopqrstuvwxyz - tests(14)%chars = [(achar(j),j=123,126)]! {|}~ - tests(15)%chars = [(achar(j),j=127,127)]! backspace character - - ! loop through functions - do i = 1, 15 - table(i,1) = all(is_control(tests(i)%chars)) - table(i,2) = all(is_printable(tests(i)%chars)) - table(i,3) = all(is_white(tests(i)%chars)) - table(i,4) = all(is_blank(tests(i)%chars)) - table(i,5) = all(is_graphical(tests(i)%chars)) - table(i,6) = all(is_punctuation(tests(i)%chars)) - table(i,7) = all(is_alphanum(tests(i)%chars)) - table(i,8) = all(is_alpha(tests(i)%chars)) - table(i,9) = all(is_upper(tests(i)%chars)) - table(i,10) = all(is_lower(tests(i)%chars)) - table(i,11) = all(is_digit(tests(i)%chars)) - table(i,12) = all(is_hex_digit(tests(i)%chars)) - end do - - call check(error, all(table .eqv. ascii_class_table), "ascii table was not accurately generated") + call ascii_table(arr) + call check(error, all(arr .eqv. ascii_class_table), "ascii table was not accurately generated") end subroutine test_ascii_table From 8012ac8d0dd03b2a31aff345e08a93399f1a06df Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Sat, 5 Jul 2025 21:08:49 +0530 Subject: [PATCH 28/54] improve test flow a bit --- test/system/test_filesystem.f90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index 0f5e24ea1..add6a9323 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -166,7 +166,6 @@ subroutine test_make_directory(error) ! Clean up: remove the empty directory call execute_command_line('rmdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup make_directory test: '//trim(msg)) - if (allocated(error)) return end subroutine test_make_directory subroutine test_make_directory_existing(error) @@ -187,8 +186,12 @@ subroutine test_make_directory_existing(error) ! Clean up: remove the empty directory call execute_command_line('rmdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + if (allocated(error)) then + ! if previous error is allocated as well + call check(error, ios==0 .and. iocmd==0, error%message // ' and cannot cleanup make_directory test: '//trim(msg)) + return + end if call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup make_directory test: '//trim(msg)) - if (allocated(error)) return end subroutine test_make_directory_existing subroutine test_remove_directory(error) @@ -209,8 +212,7 @@ subroutine test_remove_directory(error) if (allocated(error)) then ! Clean up: remove the empty directory call execute_command_line('rmdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) - call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup make_directory test: '//trim(msg)) - if (allocated(error)) return + call check(error, ios==0 .and. iocmd==0, error%message // ' and cannot cleanup make_directory test: '//trim(msg)) end if end subroutine test_remove_directory From 45824b52fcb193c4397b7e5a788be737f64f1127 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Sat, 21 Jun 2025 17:28:10 +0530 Subject: [PATCH 29/54] remove pre-processor parameters --- CMakeLists.txt | 6 ------ config/fypp_deployment.py | 2 -- example/system/example_path_base_name.f90 | 4 ++-- example/system/example_path_dir_name.f90 | 4 ++-- example/system/example_path_join.f90 | 4 ++-- example/system/example_path_split_path.f90 | 4 ++-- src/stdlib_system.F90 | 23 +++++++++++---------- src/stdlib_system_path.f90 | 24 ++++++++++++---------- test/system/test_path.f90 | 12 +++++------ 9 files changed, 39 insertions(+), 44 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index f19d3a9a8..f14326533 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -31,12 +31,6 @@ 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 204ee57c5..aa44b1df0 100644 --- a/config/fypp_deployment.py +++ b/config/fypp_deployment.py @@ -1,5 +1,4 @@ import os -import platform import fypp import argparse from joblib import Parallel, delayed @@ -116,7 +115,6 @@ 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/example/system/example_path_base_name.f90 b/example/system/example_path_base_name.f90 index de5cd33d3..0e5f46cb1 100644 --- a/example/system/example_path_base_name.f90 +++ b/example/system/example_path_base_name.f90 @@ -1,9 +1,9 @@ ! Usage of base_name program example_path_base_name - use stdlib_system, only: base_name, ISWIN + use stdlib_system, only: base_name, OS_TYPE, OS_WINDOWS character(len=:), allocatable :: p1 - if( ISWIN ) then + if(OS_TYPE() == OS_WINDOWS) then p1 = 'C:\Users' else p1 = '/home' diff --git a/example/system/example_path_dir_name.f90 b/example/system/example_path_dir_name.f90 index c8ba1290e..aff61077b 100644 --- a/example/system/example_path_dir_name.f90 +++ b/example/system/example_path_dir_name.f90 @@ -1,9 +1,9 @@ ! Usage of dir_name program example_path_dir_name - use stdlib_system, only: dir_name, ISWIN + use stdlib_system, only: dir_name, OS_TYPE, OS_WINDOWS character(len=:), allocatable :: p1, head, tail - if( ISWIN ) then + if(OS_TYPE() == OS_WINDOWS) then p1 = 'C:\Users' ! C:\Users else p1 = '/home' ! /home diff --git a/example/system/example_path_join.f90 b/example/system/example_path_join.f90 index c7c171a9d..cdeb24a90 100644 --- a/example/system/example_path_join.f90 +++ b/example/system/example_path_join.f90 @@ -1,10 +1,10 @@ ! Usage of join_path, operator(/) program example_path_join - use stdlib_system, only: join_path, operator(/), ISWIN + use stdlib_system, only: join_path, operator(/), OS_TYPE, OS_WINDOWS character(len=:), allocatable :: p1, p2, p3 character(len=20) :: parr(4) - if( ISWIN ) then + 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'] diff --git a/example/system/example_path_split_path.f90 b/example/system/example_path_split_path.f90 index b79ccf1cb..00054d786 100644 --- a/example/system/example_path_split_path.f90 +++ b/example/system/example_path_split_path.f90 @@ -1,9 +1,9 @@ ! Usage of split_path program example_path_split_path - use stdlib_system, only: join_path, split_path, ISWIN + use stdlib_system, only: join_path, split_path, OS_TYPE, OS_WINDOWS character(len=:), allocatable :: p1, head, tail - if( ISWIN ) then + 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 diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 3cf299360..c2ab5cbab 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -85,14 +85,7 @@ module stdlib_system 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 :: path_sep public :: join_path public :: operator(/) public :: split_path @@ -572,12 +565,12 @@ end function process_get_ID !! 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) + module function join2(p1, p2) result(path) character(:), allocatable :: path character(*), intent(in) :: p1, p2 end function join2 - module pure function joinarr(p) result(path) + module function joinarr(p) result(path) character(:), allocatable :: path character(*), intent(in) :: p(:) end function joinarr @@ -590,7 +583,7 @@ end function joinarr !! 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) + module function join_op(p1, p2) result(path) character(:), allocatable :: path character(*), intent(in) :: p1, p2 end function join_op @@ -866,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 diff --git a/src/stdlib_system_path.f90 b/src/stdlib_system_path.f90 index 2dff040a7..62633b23a 100644 --- a/src/stdlib_system_path.f90 +++ b/src/stdlib_system_path.f90 @@ -2,21 +2,21 @@ use stdlib_ascii, only: reverse use stdlib_strings, only: chomp, find, join contains - module pure function join2(p1, p2) result(path) + module function join2(p1, p2) result(path) character(:), allocatable :: path character(*), intent(in) :: p1, p2 - path = trim(p1) // pathsep // trim(p2) + path = trim(p1) // path_sep() // trim(p2) end function join2 - module pure function joinarr(p) result(path) + module function joinarr(p) result(path) character(:), allocatable :: path character(*), intent(in) :: p(:) - path = join(p, pathsep) + path = join(p, path_sep()) end function joinarr - module pure function join_op(p1, p2) result(path) + module function join_op(p1, p2) result(path) character(:), allocatable :: path character(*), intent(in) :: p1, p2 @@ -28,6 +28,8 @@ module subroutine split_path(p, head, tail) 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 @@ -37,19 +39,19 @@ module subroutine split_path(p, head, tail) end if ! Remove trailing path separators - temp = trim(chomp(trim(p), pathsep)) + temp = trim(chomp(trim(p), sep)) if (temp == '') then - head = pathsep + head = sep tail = '' return end if - i = find(reverse(temp), pathsep) + i = find(reverse(temp), sep) ! if no `pathsep`, then it probably was a root dir like `C:\` if (i == 0) then - head = temp // pathsep + head = temp // sep tail = '' return end if @@ -57,8 +59,8 @@ module subroutine split_path(p, head, tail) head = temp(:len(temp)-i) ! child of a root directory - if (find(head, pathsep) == 0) then - head = head // pathsep + if (find(head, sep) == 0) then + head = head // sep end if tail = temp(len(temp)-i+2:) diff --git a/test/system/test_path.f90 b/test/system/test_path.f90 index 2027ead07..8d892b928 100644 --- a/test/system/test_path.f90 +++ b/test/system/test_path.f90 @@ -1,6 +1,6 @@ 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 + use stdlib_system, only: join_path, operator(/), split_path, OS_TYPE, OS_WINDOWS implicit none contains !> Collect all exported unit tests @@ -32,7 +32,7 @@ subroutine test_join_path(error) character(len=:), allocatable :: path character(len=20) :: paths(5) - if (ISWIN) then + 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 @@ -43,8 +43,8 @@ subroutine test_join_path(error) 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) + 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') @@ -64,7 +64,7 @@ subroutine test_join_path_op(error) type(error_type), allocatable, intent(out) :: error character(len=:), allocatable :: path - if (ISWIN) then + 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 @@ -85,7 +85,7 @@ subroutine test_split_path(error) call checkpath(error, 'split_path-tail', '', tail) if (allocated(error)) return - if (ISWIN) then + if (OS_TYPE() == OS_WINDOWS) then call split_path('\\\\', head, tail) call checkpath(error, 'split_path-head', '\', head) if (allocated(error)) return From e7a3a1ffec018c13cc48447c7106ddf620542868 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Sat, 12 Jul 2025 17:41:18 +0530 Subject: [PATCH 30/54] 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 31/54] 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 32/54] 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 ee40f44b4f3e1b6d0ac8e6bc6b2d74f42a825102 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Sun, 13 Jul 2025 23:48:55 +0530 Subject: [PATCH 33/54] typos and grammar --- doc/specs/stdlib_system.md | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index e0668934b..bc56a9150 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -557,7 +557,7 @@ Pure function `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. +`p`: Shall be a list of character strings. It is an `intent(in)` argument. ### Return values @@ -581,9 +581,9 @@ Pure function. ### Arguments -`lval`: A character string, `intent(in)`. +`lval`: A character string. It is an `intent(in)` argument. -`rval`: A character string, `intent(in)`. +`rval`: A character string. It is an `intent(in)` argument. ### Result value @@ -615,15 +615,15 @@ 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)` +`p`: A character string containing the path to be split. It is an `intent(in)` argument. +`head`: The first part of the path. It is an `allocatable, intent(out)` argument. +`tail`: The rest part of the path. It is an `allocatable, intent(out)` argument. ### 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 +- 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 @@ -654,11 +654,11 @@ Function ### Arguments -`p`: the path, a character string, `intent(in)` +`p`: the path, a character string. It is an `intent(in)` argument. ### Behavior -- The `tail` of `stdlib_system(module):split_path(interface)` is exactly what is returned. Same Behavior. +- The `tail` of `[[stdlib_system(module):split_path(interface)]]` is exactly what is returned. Same Behavior. ### Return values @@ -689,11 +689,11 @@ Function ### Arguments -`p`: the path, a character string, `intent(in)` +`p`: the path, a character string. It is an `intent(in)` argument. ### Behavior -- The `head` of `stdlib_system(module):split_path(interface)` is exactly what is returned. Same Behavior. +- The `head` of `[[stdlib_system(module):split_path(interface)]]` is exactly what is returned. Same Behavior. ### Return values From e6add70cd391039052f21bc15c40a6d17a62ce3a Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Tue, 15 Jul 2025 00:00:34 +0530 Subject: [PATCH 34/54] added new procedures to the interfaces --- src/stdlib_system.F90 | 81 ++++++++++++++++++++++++++++++++++++------- 1 file changed, 68 insertions(+), 13 deletions(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index c2ab5cbab..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 @@ -565,15 +566,37 @@ end function process_get_ID !! 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) + module function join2_char_char(p1, p2) result(path) character(:), allocatable :: path character(*), intent(in) :: p1, p2 - end function join2 + end function join2_char_char - module function joinarr(p) result(path) + 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 + 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(/) @@ -583,10 +606,27 @@ end function joinarr !! 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) + module function join_op_char_char(p1, p2) result(path) character(:), allocatable :: path character(*), intent(in) :: p1, p2 - end function join_op + 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 @@ -602,10 +642,15 @@ end function join_op !! 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) + module subroutine split_path_char(p, head, tail) character(*), intent(in) :: p character(:), allocatable, intent(out) :: head, tail - end subroutine split_path + 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 @@ -617,10 +662,15 @@ end subroutine split_path !! !!### Description !! The value returned is the `tail` of the interface `split_path` - module function base_name(p) result(base) + module function base_name_char(p) result(base) character(:), allocatable :: base character(*), intent(in) :: p - end function base_name + 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 @@ -632,10 +682,15 @@ end function base_name !! !!### Description !! The value returned is the `head` of the interface `split_path` - module function dir_name(p) result(base) - character(:), allocatable :: base + module function dir_name_char(p) result(dir) + character(:), allocatable :: dir character(*), intent(in) :: p - end function dir_name + 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 From 616040dfe23f4e97e61ee503a2f4bf782982cd43 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Tue, 15 Jul 2025 00:00:59 +0530 Subject: [PATCH 35/54] implemented the new procedures --- src/stdlib_system_path.f90 | 106 ++++++++++++++++++++++++++++++++----- 1 file changed, 94 insertions(+), 12 deletions(-) diff --git a/src/stdlib_system_path.f90 b/src/stdlib_system_path.f90 index 62633b23a..6546ee44e 100644 --- a/src/stdlib_system_path.f90 +++ b/src/stdlib_system_path.f90 @@ -1,29 +1,83 @@ 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, assignment(=) contains - module function join2(p1, p2) result(path) + 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 + end function join2_char_char - module function joinarr(p) result(path) + 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 + + path = join_path(char(p1), 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 + + path = join_path(char(p1), char(p2)) + 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 + end function joinarr_char - module function join_op(p1, p2) result(path) + 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 + 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, char(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 - module subroutine split_path(p, head, tail) + path = join_path(char(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(char(p1), char(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 @@ -64,19 +118,47 @@ module subroutine split_path(p, head, tail) end if tail = temp(len(temp)-i+2:) - end subroutine split_path + 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) + + head = head_char + tail = tail_char + end subroutine split_path_string - module function base_name(p) result(base) + 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 + end function base_name_char - module function dir_name(p) result(dir) + 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 + 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 From 812b5ed391e3d1915bc711b448b4f79e142cc3f3 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Tue, 15 Jul 2025 00:01:30 +0530 Subject: [PATCH 36/54] modified the docs to add `type(string_type)` arguments --- doc/specs/stdlib_system.md | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index bc56a9150..c01788656 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -555,13 +555,13 @@ Pure function ### Arguments -`p1, p2`: Shall be a character string. It is an `intent(in)` argument. +`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. It is an `intent(in)` argument. +`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. +The resultant path, either a character string or `type(string_type)`. ## `operator(/)` @@ -581,13 +581,13 @@ Pure function. ### Arguments -`lval`: A character string. It is an `intent(in)` argument. +`lval`: A character string or `type(string_type)`. It is an `intent(in)` argument. -`rval`: A character string. 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 +The result is an `allocatable` character string or `type(string_type)` #### Example @@ -615,9 +615,9 @@ Subroutine ### Arguments -`p`: A character string containing the path to be split. It is an `intent(in)` argument. -`head`: The first part of the path. It is an `allocatable, intent(out)` argument. -`tail`: The rest part of the path. It is an `allocatable, intent(out)` argument. +`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 @@ -654,7 +654,7 @@ Function ### Arguments -`p`: the path, a character string. It is an `intent(in)` argument. +`p`: the path, a character string or `type(string_type)`. It is an `intent(in)` argument. ### Behavior @@ -662,7 +662,7 @@ Function ### Return values -A character string. +A character string or `type(string_type)`. ### Example @@ -689,7 +689,7 @@ Function ### Arguments -`p`: the path, a character string. It is an `intent(in)` argument. +`p`: the path, a character string or `type(string_type)`. It is an `intent(in)` argument. ### Behavior @@ -697,7 +697,7 @@ Function ### Return values -A character string. +A character string or `type(string_type)`. ### Example From a21a48bf99b75a2108e8f17691d9b652bfc365ae Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 16 Jul 2025 13:45:45 +0530 Subject: [PATCH 37/54] `assignment(=)` => `move` --- src/stdlib_system_path.f90 | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/src/stdlib_system_path.f90 b/src/stdlib_system_path.f90 index 6546ee44e..c2ad1aec8 100644 --- a/src/stdlib_system_path.f90 +++ b/src/stdlib_system_path.f90 @@ -1,7 +1,7 @@ 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, assignment(=) + use stdlib_string_type, only: string_type, char, move contains module function join2_char_char(p1, p2) result(path) character(:), allocatable :: path @@ -22,15 +22,21 @@ 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 - path = join_path(char(p1), p2) + 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)) - path = join_path(char(p1), char(p2)) + call move(join_char, path) end function join2_string_string module function joinarr_char(p) result(path) @@ -59,7 +65,7 @@ module function join_op_char_string(p1, p2) result(path) character(*), intent(in) :: p1 type(string_type), intent(in) :: p2 - path = join_path(p1, char(p2)) + path = join_path(p1, p2) end function join_op_char_string module function join_op_string_char(p1, p2) result(path) @@ -67,14 +73,14 @@ module function join_op_string_char(p1, p2) result(path) type(string_type), intent(in) :: p1 character(*), intent(in) :: p2 - path = join_path(char(p1), 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(char(p1), char(p2)) + path = join_path(p1, p2) end function join_op_string_string module subroutine split_path_char(p, head, tail) @@ -128,8 +134,8 @@ module subroutine split_path_string(p, head, tail) call split_path(char(p), head_char, tail_char) - head = head_char - tail = 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) From 2c473546f8e89237e378ee4fd0623b0c0126b6b0 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Thu, 17 Jul 2025 00:59:14 +0530 Subject: [PATCH 38/54] 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 39/54] 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 40/54] 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 41/54] 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 42/54] 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 From 4564868d358e8b74b4d585cf71af2adaa1d806bb Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Sun, 20 Jul 2025 14:29:36 +0530 Subject: [PATCH 43/54] Make script executable --- .github/collab.sh | 0 1 file changed, 0 insertions(+), 0 deletions(-) mode change 100644 => 100755 .github/collab.sh diff --git a/.github/collab.sh b/.github/collab.sh old mode 100644 new mode 100755 From 9d6325e2dfbd3a123e89c146f28922abba7699ee Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 23 Jul 2025 01:03:26 +0530 Subject: [PATCH 44/54] remove `mode` argument, some minor changes --- doc/specs/stdlib_system.md | 14 +++--- example/system/example_make_directory.f90 | 6 +-- example/system/example_remove_directory.f90 | 4 +- src/stdlib_system.F90 | 56 ++++++++------------- src/stdlib_system.c | 17 ++----- test/system/test_filesystem.f90 | 8 ++- 6 files changed, 44 insertions(+), 61 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index cedf39659..29716990a 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -543,12 +543,12 @@ Experimental ### Description -It creates an empty directory. +It creates an empty directory with default permissions. It is designed to work across multiple platforms. On Windows, paths with both forward `/` and backward `\` slashes are accepted. ### Syntax -`call [[stdlib_system(module):make_directory(subroutine)]] (path, mode, err)` +`call [[stdlib_system(module):make_directory(subroutine)]] (path [,err])` ### Class @@ -558,13 +558,11 @@ Subroutine `path`: Shall be a character string containing the path of the directory to create. It is an `intent(in)` argument. -`mode`: Shall be a scalar integer indicating the permission bits required (Not applicable to Windows). It is an `optional, intent(in)` argument. - -`err`: Shall be of type `state_type`, for error handling. It is an `optional, intent(out)` argument. +`err`(optional): Shall be of type `state_type`, for error handling. It is an `optional, intent(out)` argument. ### Return values -The `err` is set accordingly. +`err` is an optional state return flag. On error if not requested, a `FS_ERROR` will trigger an error stop. ### Example @@ -597,11 +595,11 @@ Subroutine `path`: Shall be a character string containing the path of the directory to create. It is an `intent(in)` argument. -`err`: Shall be of type `state_type`, for error handling. It is an `intent(out)` argument. +`err`(optional): Shall be of type `state_type`, for error handling. It is an `intent(out)` argument. ### Return values -The `err` is set accordingly. +`err` is an optional state return flag. On error if not requested, a `FS_ERROR` will trigger an error stop. ### Example diff --git a/example/system/example_make_directory.f90 b/example/system/example_make_directory.f90 index 5e551b810..456813c14 100644 --- a/example/system/example_make_directory.f90 +++ b/example/system/example_make_directory.f90 @@ -1,12 +1,12 @@ -! Illustrate the usage of make_directory +! Illustrate the usage of `make_directory` program example_make_directory - use stdlib_system, only: make_directory, is_directory + use stdlib_system, only: make_directory use stdlib_error, only: state_type implicit none type(state_type) :: err - call make_directory("test", err=err) + call make_directory("temp_dir", err) if (err%error()) then print *, err%print() diff --git a/example/system/example_remove_directory.f90 b/example/system/example_remove_directory.f90 index 993adf4f9..03465312d 100644 --- a/example/system/example_remove_directory.f90 +++ b/example/system/example_remove_directory.f90 @@ -1,6 +1,6 @@ -! Illustrate the usage of remove_directory +! Illustrate the usage of `remove_directory` program example_remove_directory - use stdlib_system, only: make_directory, is_directory, remove_directory + use stdlib_system, only: remove_directory use stdlib_error, only: state_type implicit none diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index ac36d58d7..14878145a 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -2,8 +2,9 @@ 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, ends_with use stdlib_string_type, only: string_type +use stdlib_optval, only: optval use stdlib_error, only: state_type, STDLIB_SUCCESS, STDLIB_FS_ERROR implicit none private @@ -115,12 +116,12 @@ module stdlib_system !! ([Specification](../page/specs/stdlib_system.html#make_directory)) !! !! ### Summary -!! Creates an empty directory with particular permissions. +!! Creates an empty directory with default permissions. !! !! ### Description !! This function makes an empty directory according to the path provided. -!! Relative paths as well as on Windows paths involving either `/` or `\` are accepted -!! appropriate error message is returned whenever any error occur. +!! Relative paths as well as on Windows, paths involving either `/` or `\` are accepted. +!! Appropriate error message is returned whenever any error occurs. !! public :: make_directory @@ -130,12 +131,12 @@ module stdlib_system !! ([Specification](../page/specs/stdlib_system.html#remove_directory)) !! !! ### Summary -!! Deletes an empty directory. +!! Removes an empty directory. !! !! ### Description -!! This function deletes an empty directory according to the path provided. +!! This function Removes an empty directory according to the path provided. !! Relative paths as well as on Windows paths involving either `/` or `\` are accepted. -!! appropriate error message is returned whenever any error occur. +!! Appropriate error message is returned whenever any error occurs. !! public :: remove_directory @@ -879,6 +880,9 @@ end function stdlib_is_directory end function is_directory +! A helper function to get the result of the C function `strerror`. +! `strerror` is a function provided by ``. +! It returns a string describing the meaning of `errno` in the C header `` function c_get_strerror() result(str) character(len=:), allocatable :: str @@ -906,40 +910,27 @@ end function strerror end function c_get_strerror !! makes an empty directory -subroutine make_directory(path, mode, err) +subroutine make_directory(path, err) character(len=*), intent(in) :: path - integer, intent(in), optional :: mode type(state_type), optional, intent(out) :: err integer :: code type(state_type) :: err0 - interface - integer function stdlib_make_directory(cpath, cmode) bind(C, name='stdlib_make_directory') + integer function stdlib_make_directory(cpath) bind(C, name='stdlib_make_directory') import c_char character(kind=c_char), intent(in) :: cpath(*) - integer, intent(in) :: cmode end function stdlib_make_directory end interface - if (is_windows() .and. present(mode)) then - ! _mkdir() doesn't have a `mode` argument - err0 = state_type(STDLIB_FS_ERROR, "mode argument not present for Windows") + code = stdlib_make_directory(to_c_char(trim(path))) + + if (code /= 0) then + err0 = FS_ERROR_CODE(code, c_get_strerror()) call err0%handle(err) - return end if - code = stdlib_make_directory(to_c_char(trim(path)), mode) - - select case (code) - case (0) - return - case default - ! error - err0 = state_type(STDLIB_FS_ERROR, "code:", to_string(code)//',', c_get_strerror()) - call err0%handle(err) - end select end subroutine make_directory !! Removes an empty directory @@ -959,14 +950,11 @@ end function stdlib_remove_directory code = stdlib_remove_directory(to_c_char(trim(path))) - select case (code) - case (0) - return - case default - ! error - err0 = state_type(STDLIB_FS_ERROR, "code:", to_string(code)//',', c_get_strerror()) - call err0%handle(err) - end select + if (code /= 0) then + err0 = FS_ERROR_CODE(code, c_get_strerror()) + call err0%handle(err) + end if + end subroutine remove_directory !> Returns the file path of the null device for the current operating system. diff --git a/src/stdlib_system.c b/src/stdlib_system.c index 2d9368cc3..257fc22f2 100644 --- a/src/stdlib_system.c +++ b/src/stdlib_system.c @@ -15,19 +15,16 @@ char* stdlib_strerror(size_t* len){ return err; } -int stdlib_make_directory(const char* path, mode_t mode){ +int stdlib_make_directory(const char* path){ int code; #ifdef _WIN32 code = _mkdir(path); #else - code = mkdir(path, mode); + // Default mode 0777 + code = mkdir(path, 0777); #endif /* ifdef _WIN32 */ - if (!code){ - return 0; - } - - return errno; + return (!code) ? 0 : errno; } int stdlib_remove_directory(const char* path){ @@ -38,9 +35,5 @@ int stdlib_remove_directory(const char* path){ code = rmdir(path); #endif /* ifdef _WIN32 */ - if (!code){ - return 0; - } - - return errno; + return (!code) ? 0 : errno; } diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index 5b8c65e81..7f0a216cf 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -1,6 +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_system, only: is_directory, delete_file, FS_ERROR, FS_ERROR_CODE, & + make_directory, remove_directory use stdlib_error, only: state_type, STDLIB_FS_ERROR implicit none @@ -207,11 +208,13 @@ subroutine test_make_directory_existing(error) ! Clean up: remove the empty directory call execute_command_line('rmdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + if (allocated(error)) then ! if previous error is allocated as well call check(error, ios==0 .and. iocmd==0, error%message // ' and cannot cleanup make_directory test: '//trim(msg)) return end if + call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup make_directory test: '//trim(msg)) end subroutine test_make_directory_existing @@ -230,6 +233,7 @@ subroutine test_remove_directory(error) call remove_directory(filename, err) call check(error, err%ok(), 'Could not remove directory: '//err%print()) + if (allocated(error)) then ! Clean up: remove the empty directory call execute_command_line('rmdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) @@ -242,7 +246,7 @@ subroutine test_remove_directory_nonexistent(error) type(state_type) :: err call remove_directory("random_name", err) - call check(error, err%error(), 'Somehow removed a non-existent directory!: ') + call check(error, err%error(), 'Somehow removed a non-existent directory') if (allocated(error)) return end subroutine test_remove_directory_nonexistent From 3c8262556d9288b7bbc658ee9ece2038f17543b6 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 23 Jul 2025 02:42:55 +0530 Subject: [PATCH 45/54] add make_directory_all --- src/stdlib_system.F90 | 63 +++++++++++++++++++++++++++++++++++++- src/stdlib_system_path.f90 | 2 +- 2 files changed, 63 insertions(+), 2 deletions(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 14878145a..813427f66 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, ends_with +use stdlib_strings, only: to_c_char, find use stdlib_string_type, only: string_type use stdlib_optval, only: optval use stdlib_error, only: state_type, STDLIB_SUCCESS, STDLIB_FS_ERROR @@ -125,6 +125,22 @@ module stdlib_system !! public :: make_directory +!! version: experimental +!! +!! Makes an empty directory, also creating all the parent directories required. +!! ([Specification](../page/specs/stdlib_system.html#make_directory)) +!! +!! ### Summary +!! Creates an empty directory with all the parent directories required to do so. +!! +!! ### Description +!! This function makes an empty directory according to the path provided. +!! It also creates all the parent directories required in doing so. +!! Relative paths as well as on Windows, paths involving either `/` or `\` are accepted. +!! Appropriate error message is returned whenever any error occurs. +!! +public :: make_directory_all + !! version: experimental !! !! Removes an empty directory. @@ -933,6 +949,51 @@ end function stdlib_make_directory end subroutine make_directory +subroutine make_directory_all(path, err) + character(len=*), intent(in) :: path + type(state_type), optional, intent(out) :: err + + integer :: code, i, indx + type(state_type) :: err0 + character(len=1) :: sep + logical :: is_dir + + sep = path_sep() + i = 1 + indx = find(path, sep, i) + + do + ! Base case to exit the loop + if (indx == 0 .or. indx == len(trim(path))) then + is_dir = is_directory(path) + + if (.not. is_dir) then + call make_directory(path, err0) + + if (err0%error()) then + call err0%handle(err) + end if + + return + end if + end if + + is_dir = is_directory(path(1:indx)) + + if (.not. is_dir) then + call make_directory(path(1:indx), err0) + + if (err0%error()) then + call err0%handle(err) + return + end if + end if + + i = i + 1 + indx = find(path, sep, i) + end do +end subroutine make_directory_all + !! Removes an empty directory subroutine remove_directory(path, err) character(len=*), intent(in) :: path diff --git a/src/stdlib_system_path.f90 b/src/stdlib_system_path.f90 index c2ad1aec8..5ec7ef8c8 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, find, join + use stdlib_strings, only: chomp, join use stdlib_string_type, only: string_type, char, move contains module function join2_char_char(p1, p2) result(path) From 85b522ba042723b6d94b8a035bff4dd91a8b0525 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 23 Jul 2025 02:43:10 +0530 Subject: [PATCH 46/54] add test --- test/system/test_filesystem.f90 | 54 ++++++++++++++++++++++++--------- 1 file changed, 39 insertions(+), 15 deletions(-) diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index 7f0a216cf..5c18f9bf8 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, & - make_directory, remove_directory + make_directory, remove_directory, make_directory_all, is_windows use stdlib_error, only: state_type, STDLIB_FS_ERROR implicit none @@ -22,6 +22,7 @@ subroutine collect_suite(testsuite) new_unittest("fs_delete_file_being_dir", test_delete_directory), & new_unittest("fs_make_dir", test_make_directory), & new_unittest("fs_make_dir_existing_dir", test_make_directory_existing), & + new_unittest("fs_make_dir_all", test_make_directory_all), & new_unittest("fs_remove_dir", test_remove_directory), & new_unittest("fs_remove_dir_non_existent", test_remove_directory_nonexistent) & ] @@ -175,39 +176,39 @@ end subroutine test_delete_directory subroutine test_make_directory(error) type(error_type), allocatable, intent(out) :: error type(state_type) :: err - character(len=256) :: filename + character(len=256) :: dir_name integer :: ios,iocmd character(len=512) :: msg - filename = "test_directory" + dir_name = "test_directory" - call make_directory(filename, err=err) + call make_directory(dir_name, err=err) call check(error, err%ok(), 'Could not make directory: '//err%print()) if (allocated(error)) return ! Clean up: remove the empty directory - call execute_command_line('rmdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call execute_command_line('rmdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup make_directory test: '//trim(msg)) end subroutine test_make_directory subroutine test_make_directory_existing(error) type(error_type), allocatable, intent(out) :: error type(state_type) :: err - character(len=256) :: filename + character(len=256) :: dir_name integer :: ios,iocmd character(len=512) :: msg - filename = "test_directory" + dir_name = "test_directory" - call execute_command_line('mkdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call execute_command_line('mkdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) call check(error, ios==0 .and. iocmd==0, 'Cannot init make_directory_existing test: '//trim(msg)) if (allocated(error)) return - call make_directory(filename, err=err) + call make_directory(dir_name, err=err) call check(error, err%error(), 'Made an already existing directory somehow') ! Clean up: remove the empty directory - call execute_command_line('rmdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call execute_command_line('rmdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) if (allocated(error)) then ! if previous error is allocated as well @@ -218,25 +219,48 @@ subroutine test_make_directory_existing(error) call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup make_directory test: '//trim(msg)) end subroutine test_make_directory_existing + subroutine test_make_directory_all(error) + type(error_type), allocatable, intent(out) :: error + type(state_type) :: err + character(len=256) :: dir_name + integer :: ios,iocmd + character(len=512) :: msg + + dir_name = "d1/d2/d3/d4/" + + call make_directory_all(dir_name, err=err) + call check(error, err%ok(), 'Could not make all directories: '//err%print()) + if (allocated(error)) return + + ! Clean up: remove the empty directory + if (is_windows()) then + call execute_command_line('rmdir /s /q ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + else + call execute_command_line('rm -rf ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + end if + + call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup make_directory_all test: '//trim(msg)) + end subroutine test_make_directory_all + subroutine test_remove_directory(error) type(error_type), allocatable, intent(out) :: error type(state_type) :: err - character(len=256) :: filename + character(len=256) :: dir_name integer :: ios,iocmd character(len=512) :: msg - filename = "test_directory" + dir_name = "test_directory" - call execute_command_line('mkdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call execute_command_line('mkdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) call check(error, ios==0 .and. iocmd==0, 'Cannot init remove_directory test: '//trim(msg)) if (allocated(error)) return - call remove_directory(filename, err) + call remove_directory(dir_name, err) call check(error, err%ok(), 'Could not remove directory: '//err%print()) if (allocated(error)) then ! Clean up: remove the empty directory - call execute_command_line('rmdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call execute_command_line('rmdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) call check(error, ios==0 .and. iocmd==0, error%message // ' and cannot cleanup make_directory test: '//trim(msg)) end if end subroutine test_remove_directory From f6829c88e378ab5c77d69b4b086153cf4bbb61f7 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 23 Jul 2025 02:43:21 +0530 Subject: [PATCH 47/54] add docs --- doc/specs/stdlib_system.md | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 29716990a..035ab2034 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -572,6 +572,44 @@ Subroutine --- +## `make_directory_all` - Creates an empty directory with all its parent directories + +### Status + +Experimental + +### Description + +It creates an empty directory with default permissions. +It also creates all the parent directories required in doing so. +It is designed to work across multiple platforms. On Windows, paths with both forward `/` and backward `\` slashes are accepted. + +### Syntax + +`call [[stdlib_system(module):make_directory_all(subroutine)]] (path [,err])` + +### Class + +Subroutine + +### Arguments + +`path`: Shall be a character string containing the path of the directory to create. It is an `intent(in)` argument. + +`err`(optional): Shall be of type `state_type`, for error handling. It is an `optional, intent(out)` argument. + +### Return values + +`err` is an optional state return flag. On error if not requested, a `FS_ERROR` will trigger an error stop. + +### Example + +```fortran +{!example/system/example_make_directory.f90!} +``` + +--- + ## `remove_directory` - Removes an empty directory ### Status From 81339e70469c3067f1499f40f9801a50a9c69396 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 23 Jul 2025 02:43:32 +0530 Subject: [PATCH 48/54] add example --- example/system/example_make_directory.f90 | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/example/system/example_make_directory.f90 b/example/system/example_make_directory.f90 index 456813c14..e33aab730 100644 --- a/example/system/example_make_directory.f90 +++ b/example/system/example_make_directory.f90 @@ -1,6 +1,6 @@ -! Illustrate the usage of `make_directory` +! Illustrate the usage of `make_directory`, `make_directory_all` program example_make_directory - use stdlib_system, only: make_directory + use stdlib_system, only: make_directory, make_directory_all use stdlib_error, only: state_type implicit none @@ -14,4 +14,12 @@ program example_make_directory print *, "directory created sucessfully" end if + call make_directory_all("d1/d2/d3/d4", err) + + if (err%error()) then + print *, err%print() + else + print *, "nested directories created sucessfully" + end if + end program example_make_directory From 1c4e5f7e0d1549c3e7e055527aac018b4b291a63 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 23 Jul 2025 03:04:00 +0530 Subject: [PATCH 49/54] windows specific path for tests --- doc/specs/stdlib_system.md | 1 - test/system/test_filesystem.f90 | 9 +++++++-- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 035ab2034..7da023c41 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -582,7 +582,6 @@ Experimental It creates an empty directory with default permissions. It also creates all the parent directories required in doing so. -It is designed to work across multiple platforms. On Windows, paths with both forward `/` and backward `\` slashes are accepted. ### Syntax diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index 5c18f9bf8..0c943d3f6 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -1,7 +1,8 @@ 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, & - make_directory, remove_directory, make_directory_all, is_windows + make_directory, remove_directory, make_directory_all, is_windows, OS_TYPE, & + OS_WINDOWS use stdlib_error, only: state_type, STDLIB_FS_ERROR implicit none @@ -226,7 +227,11 @@ subroutine test_make_directory_all(error) integer :: ios,iocmd character(len=512) :: msg - dir_name = "d1/d2/d3/d4/" + if (OS_TYPE() == OS_WINDOWS) then + dir_name = "d1\d2\d3\d4\" + else + dir_name = "d1/d2/d3/d4/" + end if call make_directory_all(dir_name, err=err) call check(error, err%ok(), 'Could not make all directories: '//err%print()) From 2552c3642f4f60c32633db8fe3cb0c74e540115d Mon Sep 17 00:00:00 2001 From: jalvesz <102541118+jalvesz@users.noreply.github.com> Date: Wed, 23 Jul 2025 07:52:48 +0200 Subject: [PATCH 50/54] fix: complex dot_product formulation (#1017) * fix complex dot_product formulation * smaller array and wider tolerance * Update test/intrinsics/test_intrinsics.fypp Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com> --------- Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com> --- src/stdlib_intrinsics_dot_product.fypp | 8 ++++---- test/intrinsics/test_intrinsics.fypp | 21 +++++++++++++++++++++ 2 files changed, 25 insertions(+), 4 deletions(-) diff --git a/src/stdlib_intrinsics_dot_product.fypp b/src/stdlib_intrinsics_dot_product.fypp index ce6188c8a..74bb4b4de 100644 --- a/src/stdlib_intrinsics_dot_product.fypp +++ b/src/stdlib_intrinsics_dot_product.fypp @@ -34,10 +34,10 @@ pure module function stdlib_dot_product_${s}$(a,b) result(p) n = size(a,kind=ilp) r = mod(n,chunk) - abatch(1:r) = a(1:r)*${cnjg(t,'b(1:r)')}$ + abatch(1:r) = ${cnjg(t,'a(1:r)')}$*b(1:r) abatch(r+1:chunk) = zero_${s}$ do i = r+1, n-r, chunk - abatch(1:chunk) = abatch(1:chunk) + a(i:i+chunk-1)*${cnjg(t,'b(i:i+chunk-1)')}$ + abatch(1:chunk) = abatch(1:chunk) + ${cnjg(t,'a(i:i+chunk-1)')}$*b(i:i+chunk-1) end do p = zero_${s}$ @@ -60,11 +60,11 @@ pure module function stdlib_dot_product_kahan_${s}$(a,b) result(p) n = size(a,kind=ilp) r = mod(n,chunk) - abatch(1:r) = a(1:r)*${cnjg(t,'b(1:r)')}$ + abatch(1:r) = ${cnjg(t,'a(1:r)')}$*b(1:r) abatch(r+1:chunk) = zero_${s}$ cbatch = zero_${s}$ do i = r+1, n-r, chunk - call kahan_kernel( a(i:i+chunk-1)*${cnjg(t,'b(i:i+chunk-1)')}$ , abatch(1:chunk) , cbatch(1:chunk) ) + call kahan_kernel( ${cnjg(t,'a(i:i+chunk-1)')}$*b(i:i+chunk-1) , abatch(1:chunk) , cbatch(1:chunk) ) end do p = zero_${s}$ diff --git a/test/intrinsics/test_intrinsics.fypp b/test/intrinsics/test_intrinsics.fypp index 8aefe09d3..11cf32fdc 100644 --- a/test/intrinsics/test_intrinsics.fypp +++ b/test/intrinsics/test_intrinsics.fypp @@ -246,6 +246,27 @@ subroutine test_dot_product(error) call check(error, all(err(:) Date: Wed, 23 Jul 2025 12:09:31 +0530 Subject: [PATCH 51/54] a little efficient --- src/stdlib_system.F90 | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 813427f66..e085e9169 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -953,18 +953,19 @@ subroutine make_directory_all(path, err) character(len=*), intent(in) :: path type(state_type), optional, intent(out) :: err - integer :: code, i, indx + integer :: i, indx type(state_type) :: err0 character(len=1) :: sep - logical :: is_dir + logical :: is_dir, check_is_dir sep = path_sep() i = 1 indx = find(path, sep, i) + check_is_dir = .true. do ! Base case to exit the loop - if (indx == 0 .or. indx == len(trim(path))) then + if (indx == 0) then is_dir = is_directory(path) if (.not. is_dir) then @@ -973,14 +974,19 @@ subroutine make_directory_all(path, err) if (err0%error()) then call err0%handle(err) end if - - return end if + + return end if - is_dir = is_directory(path(1:indx)) + if (check_is_dir) then + is_dir = is_directory(path(1:indx)) + end if if (.not. is_dir) then + ! no need for further `is_dir` checks + ! all paths going forward need to be created + check_is_dir = .false. call make_directory(path(1:indx), err0) if (err0%error()) then @@ -989,7 +995,7 @@ subroutine make_directory_all(path, err) end if end if - i = i + 1 + i = i + 1 ! the next occurence of `sep` indx = find(path, sep, i) end do end subroutine make_directory_all From e16f19265ff26e3b7d12b30a609de84f1ab99a4e Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 23 Jul 2025 17:58:12 +0530 Subject: [PATCH 52/54] minor comments + doc changes --- doc/specs/stdlib_system.md | 12 ++++++------ src/stdlib_system.F90 | 16 ++++++++-------- test/system/test_filesystem.f90 | 8 ++++---- 3 files changed, 18 insertions(+), 18 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 7da023c41..f57646214 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -558,11 +558,11 @@ Subroutine `path`: Shall be a character string containing the path of the directory to create. It is an `intent(in)` argument. -`err`(optional): Shall be of type `state_type`, for error handling. It is an `optional, intent(out)` argument. +`err`(optional): Shall be of type `state_type`, and is used for error handling. It is an `optional, intent(out)` argument. ### Return values -`err` is an optional state return flag. On error if not requested, a `FS_ERROR` will trigger an error stop. +`err` is an optional state return flag. If not requested and an error occurs, a `FS_ERROR` will trigger an error stop. ### Example @@ -581,7 +581,7 @@ Experimental ### Description It creates an empty directory with default permissions. -It also creates all the parent directories required in doing so. +It also creates all the necessary parent directories in the path if they do not exist already. ### Syntax @@ -595,11 +595,11 @@ Subroutine `path`: Shall be a character string containing the path of the directory to create. It is an `intent(in)` argument. -`err`(optional): Shall be of type `state_type`, for error handling. It is an `optional, intent(out)` argument. +`err`(optional): Shall be of type `state_type`, and is used for error handling. It is an `optional, intent(out)` argument. ### Return values -`err` is an optional state return flag. On error if not requested, a `FS_ERROR` will trigger an error stop. +`err` is an optional state return flag. If not requested and an error occurs, a `FS_ERROR` will trigger an error stop. ### Example @@ -632,7 +632,7 @@ Subroutine `path`: Shall be a character string containing the path of the directory to create. It is an `intent(in)` argument. -`err`(optional): Shall be of type `state_type`, for error handling. It is an `intent(out)` argument. +`err`(optional): Shall be of type `state_type`, and is used for error handling. It is an `optional, intent(out)` argument. ### Return values diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index e085e9169..bd6f9b001 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -120,8 +120,8 @@ module stdlib_system !! !! ### Description !! This function makes an empty directory according to the path provided. -!! Relative paths as well as on Windows, paths involving either `/` or `\` are accepted. -!! Appropriate error message is returned whenever any error occurs. +!! Relative paths are supported. On Windows, paths involving either `/` or `\` are accepted. +!! An appropriate error message is returned whenever any error occurs. !! public :: make_directory @@ -135,9 +135,9 @@ module stdlib_system !! !! ### Description !! This function makes an empty directory according to the path provided. -!! It also creates all the parent directories required in doing so. -!! Relative paths as well as on Windows, paths involving either `/` or `\` are accepted. -!! Appropriate error message is returned whenever any error occurs. +!! It also creates all the necessary parent directories in the path if they do not exist already. +!! Relative paths are supported. +!! An appropriate error message is returned whenever any error occurs. !! public :: make_directory_all @@ -151,8 +151,8 @@ module stdlib_system !! !! ### Description !! This function Removes an empty directory according to the path provided. -!! Relative paths as well as on Windows paths involving either `/` or `\` are accepted. -!! Appropriate error message is returned whenever any error occurs. +!! Relative paths are supported. On Windows paths involving either `/` or `\` are accepted. +!! An appropriate error message is returned whenever any error occurs. !! public :: remove_directory @@ -1000,7 +1000,7 @@ subroutine make_directory_all(path, err) end do end subroutine make_directory_all -!! Removes an empty directory +!! removes an empty directory subroutine remove_directory(path, err) character(len=*), intent(in) :: path type(state_type), optional, intent(out) :: err diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index 0c943d3f6..fc9853b5b 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -187,7 +187,7 @@ subroutine test_make_directory(error) call check(error, err%ok(), 'Could not make directory: '//err%print()) if (allocated(error)) return - ! Clean up: remove the empty directory + ! clean up: remove the empty directory call execute_command_line('rmdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup make_directory test: '//trim(msg)) end subroutine test_make_directory @@ -208,7 +208,7 @@ subroutine test_make_directory_existing(error) call make_directory(dir_name, err=err) call check(error, err%error(), 'Made an already existing directory somehow') - ! Clean up: remove the empty directory + ! clean up: remove the empty directory call execute_command_line('rmdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) if (allocated(error)) then @@ -237,7 +237,7 @@ subroutine test_make_directory_all(error) call check(error, err%ok(), 'Could not make all directories: '//err%print()) if (allocated(error)) return - ! Clean up: remove the empty directory + ! clean up: remove the empty directory if (is_windows()) then call execute_command_line('rmdir /s /q ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) else @@ -264,7 +264,7 @@ subroutine test_remove_directory(error) call check(error, err%ok(), 'Could not remove directory: '//err%print()) if (allocated(error)) then - ! Clean up: remove the empty directory + ! clean up: remove the empty directory call execute_command_line('rmdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) call check(error, ios==0 .and. iocmd==0, error%message // ' and cannot cleanup make_directory test: '//trim(msg)) end if From 95e76be7571b736efe78501241e85dcc53020bf0 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 23 Jul 2025 18:07:47 +0530 Subject: [PATCH 53/54] cleanup path make_directory_all + typo --- doc/specs/stdlib_system.md | 6 +++--- test/system/test_filesystem.f90 | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index f57646214..c6c79fcea 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -562,7 +562,7 @@ Subroutine ### Return values -`err` is an optional state return flag. If not requested and an error occurs, a `FS_ERROR` will trigger an error stop. +`err` is an optional state return flag. If not requested and an error occurs, an `FS_ERROR` will trigger an error stop. ### Example @@ -599,7 +599,7 @@ Subroutine ### Return values -`err` is an optional state return flag. If not requested and an error occurs, a `FS_ERROR` will trigger an error stop. +`err` is an optional state return flag. If not requested and an error occurs, an `FS_ERROR` will trigger an error stop. ### Example @@ -636,7 +636,7 @@ Subroutine ### Return values -`err` is an optional state return flag. On error if not requested, a `FS_ERROR` will trigger an error stop. +`err` is an optional state return flag. On error if not requested, an `FS_ERROR` will trigger an error stop. ### Example diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index fc9853b5b..af4bbedb6 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -239,9 +239,9 @@ subroutine test_make_directory_all(error) ! clean up: remove the empty directory if (is_windows()) then - call execute_command_line('rmdir /s /q ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call execute_command_line('rmdir /s /q d1', exitstat=ios, cmdstat=iocmd, cmdmsg=msg) else - call execute_command_line('rm -rf ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call execute_command_line('rm -rf d1', exitstat=ios, cmdstat=iocmd, cmdmsg=msg) end if call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup make_directory_all test: '//trim(msg)) From b13edf5f305238e63bc39e3df465ee0288b89ed3 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Thu, 24 Jul 2025 22:42:42 +0530 Subject: [PATCH 54/54] add in-code comments --- src/stdlib_system.c | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/stdlib_system.c b/src/stdlib_system.c index 257fc22f2..0bef82b8c 100644 --- a/src/stdlib_system.c +++ b/src/stdlib_system.c @@ -9,12 +9,16 @@ #include #endif /* ifdef _WIN32 */ +// Returns the string describing the meaning of `errno` code (by calling `strerror`). char* stdlib_strerror(size_t* len){ char* err = strerror(errno); *len = strlen(err); return err; } +// Wrapper to the platform's `mkdir`(make directory) call. +// Uses `mkdir` on unix, `_mkdir` on windows. +// Returns 0 if successful, otherwise returns the `errno`. int stdlib_make_directory(const char* path){ int code; #ifdef _WIN32 @@ -27,6 +31,9 @@ int stdlib_make_directory(const char* path){ return (!code) ? 0 : errno; } +// Wrapper to the platform's `rmdir`(remove directory) call. +// Uses `rmdir` on unix, `_rmdir` on windows. +// Returns 0 if successful, otherwise returns the `errno`. int stdlib_remove_directory(const char* path){ int code; #ifdef _WIN32