Skip to content

promote other ascii functions to elemental #977

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 8 commits into
base: master
Choose a base branch
from
Open

promote other ascii functions to elemental #977

Show file tree
Hide file tree
Changes from 3 commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
08e489a
promote ascii pure functions to elemental
wassup05 Apr 10, 2025
bb48f09
remove unused procedure in the test
wassup05 Apr 10, 2025
32b7bf3
refactor ascii validation test
perazz Apr 10, 2025
7e44eea
add ascii_table to the tests
wassup05 Apr 11, 2025
c580881
Update test/ascii/test_ascii.f90
perazz Apr 11, 2025
4bc022d
refactor test
jalvesz Apr 16, 2025
ddab1fb
add ascii constants docs
wassup05 Apr 16, 2025
11dd81e
add ascii procedure docs
wassup05 Apr 17, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
28 changes: 14 additions & 14 deletions src/stdlib_ascii.fypp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -107,47 +107,47 @@ 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')
end function

!> 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)
is_control = ic < int(z'20') .or. ic == int(z'7F')
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')
Expand All @@ -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) ! '~' '!'
Expand All @@ -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)
Expand All @@ -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)
Expand All @@ -186,23 +186,23 @@ 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)
is_lower = ic >= iachar('a') .and. ic <= iachar('z')
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

!> 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
Expand All @@ -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
Expand Down
81 changes: 41 additions & 40 deletions test/ascii/test_ascii.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -729,48 +729,23 @@ 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
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
Expand All @@ -779,6 +754,32 @@ pure logical function validation_func_interface(c)
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)
Expand Down
Loading