diff --git a/doc/specs/stdlib_ascii.md b/doc/specs/stdlib_ascii.md index 0bab6e8c3..9c088fbb3 100644 --- a/doc/specs/stdlib_ascii.md +++ b/doc/specs/stdlib_ascii.md @@ -14,13 +14,540 @@ 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 -@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` @@ -52,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` 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 diff --git a/test/ascii/test_ascii.f90 b/test/ascii/test_ascii.f90 index 5a8878632..57c27e2a5 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,60 +726,68 @@ 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 test_ascii_table(error) + type(error_type), allocatable, intent(out) :: error 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 + 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])) + + 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, 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 + 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 - ! 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) + call check(error, all(table .eqv. ascii_class_table), "ascii table was not accurately generated") + end subroutine test_ascii_table subroutine test_to_lower_string(error)