From 08e489a813eb5ca4d7f7bacd590d95354e914463 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Thu, 10 Apr 2025 18:16:10 +0530 Subject: [PATCH 1/8] 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 2/8] 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 3/8] 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 4/8] 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 5/8] 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 6/8] 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 7/8] 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 8/8] 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`