Skip to content

Place ASCII control characters in derived type #49

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

Closed
wants to merge 1 commit into from
+254 −183
Closed

Place ASCII control characters in derived type #49

Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
219 changes: 118 additions & 101 deletions src/stdlib_experimental_ascii.f90
View file
Original file line number Diff line number Diff line change
@@ -1,177 +1,194 @@
module stdlib_experimental_ascii

implicit none
private

! Character validation functions
public :: is_alpha, is_alphanum
public :: is_digit, is_hex_digit, is_octal_digit
public :: is_control, is_white, is_blank
public :: is_ascii, is_punctuation
public :: is_graphical, is_printable
public :: is_lower, is_upper

! Character conversion functions
public :: to_lower, to_upper

! All control characters in the ASCII table (see www.asciitable.com).
character(len=1), public, parameter :: NUL = achar(z'00') !! Null
character(len=1), public, parameter :: SOH = achar(z'01') !! Start of heading
character(len=1), public, parameter :: STX = achar(z'02') !! Start of text
character(len=1), public, parameter :: ETX = achar(z'03') !! End of text
character(len=1), public, parameter :: EOT = achar(z'04') !! End of transmission
character(len=1), public, parameter :: ENQ = achar(z'05') !! Enquiry
character(len=1), public, parameter :: ACK = achar(z'06') !! Acknowledge
character(len=1), public, parameter :: BEL = achar(z'07') !! Bell
character(len=1), public, parameter :: BS = achar(z'08') !! Backspace
character(len=1), public, parameter :: TAB = achar(z'09') !! Horizontal tab
character(len=1), public, parameter :: LF = achar(z'0A') !! NL line feed, new line
character(len=1), public, parameter :: VT = achar(z'0B') !! Vertical tab
character(len=1), public, parameter :: FF = achar(z'0C') !! NP form feed, new page
character(len=1), public, parameter :: CR = achar(z'0D') !! Carriage return
character(len=1), public, parameter :: SO = achar(z'0E') !! Shift out
character(len=1), public, parameter :: SI = achar(z'0F') !! Shift in
character(len=1), public, parameter :: DLE = achar(z'10') !! Data link escape
character(len=1), public, parameter :: DC1 = achar(z'11') !! Device control 1
character(len=1), public, parameter :: DC2 = achar(z'12') !! Device control 2
character(len=1), public, parameter :: DC3 = achar(z'13') !! Device control 3
character(len=1), public, parameter :: DC4 = achar(z'14') !! Device control 4
character(len=1), public, parameter :: NAK = achar(z'15') !! Negative acknowledge
character(len=1), public, parameter :: SYN = achar(z'16') !! Synchronous idle
character(len=1), public, parameter :: ETB = achar(z'17') !! End of transmission block
character(len=1), public, parameter :: CAN = achar(z'18') !! Cancel
character(len=1), public, parameter :: EM = achar(z'19') !! End of medium
character(len=1), public, parameter :: SUB = achar(z'1A') !! Substitute
character(len=1), public, parameter :: ESC = achar(z'1B') !! Escape
character(len=1), public, parameter :: FS = achar(z'1C') !! File separator
character(len=1), public, parameter :: GS = achar(z'1D') !! Group separator
character(len=1), public, parameter :: RS = achar(z'1E') !! Record separator
character(len=1), public, parameter :: US = achar(z'1F') !! Unit separator
character(len=1), public, parameter :: DEL = achar(z'7F') !! Delete

! Constant character sequences
character(len=*), public, parameter :: fullhex_digits = "0123456789ABCDEFabcdef" !! 0 .. 9A .. Fa .. f
character(len=*), public, parameter :: hex_digits = fullhex_digits(1:16) !! 0 .. 9A .. F
character(len=*), public, parameter :: lowerhex_digits = "0123456789abcdef" !! 0 .. 9a .. f
character(len=*), public, parameter :: digits = hex_digits(1:10) !! 0 .. 9
character(len=*), public, parameter :: octal_digits = digits(1:8) !! 0 .. 7
character(len=*), public, parameter :: letters = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" !! A .. Za .. z
character(len=*), public, parameter :: uppercase = letters(1:26) !! A .. Z
character(len=*), public, parameter :: lowercase = letters(27:) !! a .. z
character(len=*), public, parameter :: whitespace = " "//TAB//VT//CR//LF//FF !! ASCII _whitespace
implicit none
private

! Character validation functions
public :: is_alpha, is_alphanum
public :: is_digit, is_hex_digit, is_octal_digit
public :: is_control, is_white, is_blank
public :: is_ascii, is_punctuation
public :: is_graphical, is_printable
public :: is_lower, is_upper

! Character conversion functions
public :: to_lower, to_upper

! Ascii control characters
public :: ascii_control_char

! Constant character sequences
public :: fullhex_digits, hex_digits, lowerhex_digits, digits, octal_digits
public :: letters, uppercase, lowercase, whitespace


! All control characters in the ASCII table (see www.asciitable.com).
type :: ascii_control_char_t
character(len=1) :: NUL = achar(z'00') !! Null
character(len=1) :: SOH = achar(z'01') !! Start of heading
character(len=1) :: STX = achar(z'02') !! Start of text
character(len=1) :: ETX = achar(z'03') !! End of text
character(len=1) :: EOT = achar(z'04') !! End of transmission
character(len=1) :: ENQ = achar(z'05') !! Enquiry
character(len=1) :: ACK = achar(z'06') !! Acknowledge
character(len=1) :: BEL = achar(z'07') !! Bell
character(len=1) :: BS = achar(z'08') !! Backspace
character(len=1) :: TAB = achar(z'09') !! Horizontal tab
character(len=1) :: LF = achar(z'0A') !! NL line feed, new line
character(len=1) :: VT = achar(z'0B') !! Vertical tab
character(len=1) :: FF = achar(z'0C') !! NP form feed, new page
character(len=1) :: CR = achar(z'0D') !! Carriage return
character(len=1) :: SO = achar(z'0E') !! Shift out
character(len=1) :: SI = achar(z'0F') !! Shift in
character(len=1) :: DLE = achar(z'10') !! Data link escape
character(len=1) :: DC1 = achar(z'11') !! Device control 1
character(len=1) :: DC2 = achar(z'12') !! Device control 2
character(len=1) :: DC3 = achar(z'13') !! Device control 3
character(len=1) :: DC4 = achar(z'14') !! Device control 4
character(len=1) :: NAK = achar(z'15') !! Negative acknowledge
character(len=1) :: SYN = achar(z'16') !! Synchronous idle
character(len=1) :: ETB = achar(z'17') !! End of transmission block
character(len=1) :: CAN = achar(z'18') !! Cancel
character(len=1) :: EM = achar(z'19') !! End of medium
character(len=1) :: SUB = achar(z'1A') !! Substitute
character(len=1) :: ESC = achar(z'1B') !! Escape
character(len=1) :: FS = achar(z'1C') !! File separator
character(len=1) :: GS = achar(z'1D') !! Group separator
character(len=1) :: RS = achar(z'1E') !! Record separator
character(len=1) :: US = achar(z'1F') !! Unit separator
character(len=1) :: DEL = achar(z'7F') !! Delete
end type

! A single instance of the ascii control characters (initialized to default values)
type(ascii_control_char_t), parameter :: ascii_control_char = ascii_control_char_t()

! Constant character sequences
character(len=*), parameter :: fullhex_digits = "0123456789ABCDEFabcdef" !! 0 .. 9A .. Fa .. f
character(len=*), parameter :: hex_digits = fullhex_digits(1:16) !! 0 .. 9A .. F
character(len=*), parameter :: lowerhex_digits = "0123456789abcdef" !! 0 .. 9a .. f
character(len=*), parameter :: digits = hex_digits(1:10) !! 0 .. 9
character(len=*), parameter :: octal_digits = digits(1:8) !! 0 .. 7
character(len=*), parameter :: letters = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" !! A .. Za .. z
character(len=*), parameter :: uppercase = letters(1:26) !! A .. Z
character(len=*), parameter :: lowercase = letters(27:) !! a .. z
character(len=*), parameter :: whitespace = " "//ascii_control_char%TAB//&
ascii_control_char%VT//&
ascii_control_char%CR//&
ascii_control_char%LF//&
ascii_control_char%FF !! ASCII whitespace

contains

!> Checks whether `c` is an ASCII letter (A .. Z, a .. z).
pure logical function is_alpha(c)
!> Checks whether `c` is an ASCII letter (A .. Z, a .. z).
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)
!> Checks whether `c` is a letter or a number (0 .. 9, a .. z, A .. Z).
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)
!> Checks whether or not `c` is in the ASCII character set -
! i.e. in the range 0 .. 0x7F.
elemental logical function is_ascii(c)
character(len=1), intent(in) :: c !! The character to test.
is_ascii = iachar(c) <= z'7F'
end function

!> Checks whether `c` is a control character.
pure logical function is_control(c)
!> Checks whether `c` is a control character.
elemental logical function is_control(c)
character(len=1), intent(in) :: c !! The character to test.
integer :: ic
ic = iachar(c)
is_control = ic < z'20' .or. ic == z'7F'
end function

!> Checks whether `c` is a digit (0 .. 9).
pure logical function is_digit(c)
!> Checks whether `c` is a digit (0 .. 9).
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)
!> Checks whether `c` is a digit in base 8 (0 .. 7).
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)
!> Checks whether `c` is a digit in base 16 (0 .. 9, A .. F, a .. f).
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')
end function

!> 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)
!> Checks whether or not `c` is a punctuation character. That includes
! all ASCII characters which are not control characters, letters,
! digits, or whitespace.
elemental logical function is_punctuation(c)
character(len=1), intent(in) :: c !! The character to test.
integer :: ic
ic = iachar(c) ! '~' '!'
is_punctuation = (ic <= z'7E') .and. (ic >= z'21') .and. &
(.not. is_alphanum(c))
end function

!> Checks whether or not `c` is a printable character other than the
! space character.
pure logical function is_graphical(c)
!> Checks whether or not `c` is a printable character other than the
! space character.
elemental logical function is_graphical(c)
character(len=1), intent(in) :: c !! The character to test.
integer :: ic
ic = iachar(c) ! '!' '~'
is_graphical = (z'21' <= ic) .and. (ic <= z'7E')
end function

!> Checks whether or not `c` is a printable character - including the
! space character.
pure logical function is_printable(c)
!> Checks whether or not `c` is a printable character - including the
! space character.
elemental logical function is_printable(c)
character(len=1), intent(in) :: c !! The character to test.
integer :: ic
ic = iachar(c) ! '~'
is_printable = c >= ' ' .and. ic <= z'7E'
end function

!> Checks whether `c` is a lowercase ASCII letter (a .. z).
pure logical function is_lower(c)
!> Checks whether `c` is a lowercase ASCII letter (a .. z).
elemental logical function is_lower(c)
character(len=1), intent(in) :: c !! The character to test.
is_lower = (c >= 'a') .and. (c <= 'z')
end function

!> Checks whether `c` is an uppercase ASCII letter (A .. Z).
pure logical function is_upper(c)
!> Checks whether `c` is an uppercase ASCII letter (A .. Z).
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)
!> Checks whether or not `c` is a whitespace character. That includes the
! space, tab, vertical tab, form feed, carriage return, and linefeed
! characters.
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
is_white = (c == ' ') .or. (ic >= z'09' .and. ic <= z'0D');
end function

!> Checks whether or not `c` is a blank character. That includes the
! only the space and tab characters
pure logical function is_blank(c)
!> Checks whether or not `c` is a blank character. That includes
! the space and tab characters
elemental logical function is_blank(c)
character(len=1), intent(in) :: c !! The character to test.
integer :: ic
ic = iachar(c) ! TAB
is_blank = (c == ' ') .or. (ic == z'09');
end function

!> Returns the corresponding lowercase letter, if `c` is an uppercase
! ASCII character, otherwise `c` itself.
pure function to_lower(c) result(t)
!> Returns the corresponding lowercase letter, if `c` is an uppercase
! ASCII character, otherwise `c` itself.
elemental function to_lower(c) result(t)
character(len=1), intent(in) :: c !! A character.
character(len=1) :: t
integer :: diff
@@ -181,9 +198,9 @@ pure function to_lower(c) result(t)
if (is_upper(t)) t = achar(iachar(t) - diff)
end function

!> Returns the corresponding uppercase letter, if `c` is a lowercase
! ASCII character, otherwise `c` itself.
pure function to_upper(c) result(t)
!> Returns the corresponding uppercase letter, if `c` is a lowercase
! ASCII character, otherwise `c` itself.
elemental function to_upper(c) result(t)
character(len=1), intent(in) :: c !! A character.
character(len=1) :: t
integer :: diff
21 changes: 6 additions & 15 deletions src/stdlib_experimental_io.f90
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
module stdlib_experimental_io
use iso_fortran_env, only: sp=>real32, dp=>real64, qp=>real128
use stdlib_experimental_ascii, only: is_blank
implicit none
private
public :: loadtxt, savetxt
@@ -224,16 +225,16 @@ integer function number_of_columns(s)

integer :: ios
character :: c
logical :: lastwhite
logical :: lastblank

rewind(s)
number_of_columns = 0
lastwhite = .true.
lastblank = .true.
do
read(s, '(a)', advance='no', iostat=ios) c
if (ios /= 0) exit
if (lastwhite .and. .not. whitechar(c)) number_of_columns = number_of_columns + 1
lastwhite = whitechar(c)
if (lastblank .and. .not. is_blank(c)) number_of_columns = number_of_columns + 1
lastblank = is_blank(c)
end do
rewind(s)

@@ -244,7 +245,7 @@ integer function number_of_rows_numeric(s)
integer,intent(in)::s
integer :: ios

real::r
real :: r

rewind(s)
number_of_rows_numeric = 0
@@ -258,14 +259,4 @@ integer function number_of_rows_numeric(s)

end function

logical function whitechar(char) ! white character
! returns .true. if char is space (32) or tab (9), .false. otherwise
character, intent(in) :: char
if (iachar(char) == 32 .or. iachar(char) == 9) then
whitechar = .true.
else
whitechar = .false.
end if
end function

end module
197 changes: 130 additions & 67 deletions src/tests/ascii/test_ascii.f90
View file
Original file line number Diff line number Diff line change
@@ -6,7 +6,7 @@ program test_ascii
whitespace, letters, is_alphanum, is_alpha, is_lower, is_upper, &
is_digit, is_octal_digit, is_hex_digit, is_white, is_blank, &
is_control, is_punctuation, is_graphical, is_printable, is_ascii, &
to_lower, to_upper, LF, TAB, NUL, DEL
to_lower, to_upper, ascii_control_char

write(*,*) "Lowercase letters: ", lowercase
write(*,*) "Uppercase letters: ", uppercase
@@ -15,6 +15,7 @@ program test_ascii
write(*,*) "Full hex digits: ", fullhex_digits
write(*,*) "Hex digits: ", hex_digits
write(*,*) "Lower hex digits: ", lowerhex_digits
write(*,*)

call test_is_alphanum_short
call test_is_alphanum_long
@@ -64,7 +65,7 @@ program test_ascii
call test_to_upper_short
call test_to_upper_long

! call test_ascii_table
call test_ascii_table

contains

@@ -248,8 +249,8 @@ subroutine test_is_hex_digit_long
subroutine test_is_white_short
write(*,*) "test_is_white_short"
call assert(is_white(' '))
call assert(is_white(TAB))
call assert(is_white(LF))
call assert(is_white(ascii_control_char%TAB))
call assert(is_white(ascii_control_char%LF))
call assert(.not. is_white('1'))
call assert(.not. is_white('a'))
call assert(.not. is_white('#'))
@@ -271,7 +272,7 @@ subroutine test_is_white_long
subroutine test_is_blank_short
write(*,*) "test_is_blank_short"
call assert(is_blank(' '))
call assert(is_blank(TAB))
call assert(is_blank(ascii_control_char%TAB))
call assert(.not. is_blank('1'))
call assert(.not. is_blank('a'))
call assert(.not. is_blank('#'))
@@ -282,7 +283,8 @@ subroutine test_is_blank_long
character(len=:), allocatable :: clist
write(*,*) "test_is_blank_long"
do i = 1, len(whitespace)
if (whitespace(i:i) == ' ' .or. whitespace(i:i) == TAB) then
if (whitespace(i:i) == ' ' .or. &
whitespace(i:i) == ascii_control_char%TAB) then
call assert(is_blank(whitespace(i:i)))
else
call assert(.not. is_blank(whitespace(i:i)))
@@ -317,7 +319,7 @@ subroutine test_is_control_long
do i = 0, 31
call assert(is_control(achar(i)))
end do
call assert(is_control(DEL))
call assert(is_control(ascii_control_char%DEL))

clist = digits//letters//' '
do i = 1, len(clist)
@@ -339,8 +341,8 @@ subroutine test_is_punctuation_short
call assert(.not. is_punctuation('1'))
call assert(.not. is_punctuation('a'))
call assert(.not. is_punctuation(' '))
call assert(.not. is_punctuation(LF)) ! new line character
call assert(.not. is_punctuation(NUL))
call assert(.not. is_punctuation(ascii_control_char%LF)) ! new line character
call assert(.not. is_punctuation(ascii_control_char%NUL))

! N.B.: Non-ASCII Unicode punctuation characters are not recognized.
! write(*,*) is_punctuation('\u2012') ! (U+2012 = en-dash)
@@ -366,8 +368,8 @@ subroutine test_is_graphical_short
call assert(is_graphical('a'))
call assert(is_graphical('#'))
call assert(.not. is_graphical(' ')) ! whitespace is not graphical
call assert(.not. is_graphical(LF))
call assert(.not. is_graphical(NUL))
call assert(.not. is_graphical(ascii_control_char%LF))
call assert(.not. is_graphical(ascii_control_char%NUL))

! N.B.: Unicode graphical characters are not regarded as such.
call assert(.not. is_graphical('ä'))
@@ -393,7 +395,7 @@ subroutine test_is_printable_short
call assert(is_printable('1'))
call assert(is_printable('a'))
call assert(is_printable('#'))
call assert(.not. is_printable(NUL)) ! control characters are not printable
call assert(.not. is_printable(ascii_control_char%NUL)) ! control characters are not printable

! N.B.: Printable non-ASCII Unicode characters are not recognized.
call assert(.not. is_printable('ä'))
@@ -478,65 +480,126 @@ subroutine test_to_upper_long()
end do
end subroutine

!
! This test reproduces the true/false table found at
! https://en.cppreference.com/w/cpp/string/byte
!

!> This test reproduces the true/false table found at
! https://en.cppreference.com/w/cpp/string/byte
! by passing allocatable character arrays filled with subsets
! of ascii characters to the stdlib character validation functions.
!
subroutine test_ascii_table
integer :: i, j
character(len=1) :: c
logical :: table(15,12)
character(len=7) :: col

character(len=1), allocatable :: ca(:)
integer :: ic(16) ! 15 + 1

write(*,*) "test_ascii_table"

! 0-8 control codes
! 9 tab
! 10-13 whitespaces
! 14-31 control codes
! 32 space
! 33-47 !"#$%&'()*+,-./
! 48-57 0123456789
! 58-64 :;<=>?@
! 65-70 ABCDEF
! 71-90 GHIJKLMNOPQRSTUVWXYZ
! 91-96 [\]^_`
! 97-102 abcdef
! 103-122 ghijklmnopqrstuvwxyz
! 123-126 {|}~
! 127 backspace character

ic = [0,9,10,14,32,33,48,58,65,71,91,97,103,123,127,128]

do i = 1, 15
ca = [(achar(j),j=ic(i),ic(i+1)-1)]
table(i,1) = all(is_control(ca))
end do

do i = 1, 15
ca = [(achar(j),j=ic(i),ic(i+1)-1)]
table(i,2) = all(is_printable(ca))
end do

do i = 1, 15
ca = [(achar(j),j=ic(i),ic(i+1)-1)]
table(i,3) = all(is_white(ca))
end do

do i = 1, 15
ca = [(achar(j),j=ic(i),ic(i+1)-1)]
table(i,4) = all(is_blank(ca))
end do

do i = 1, 15
ca = [(achar(j),j=ic(i),ic(i+1)-1)]
table(i,5) = all(is_graphical(ca))
end do

do i = 1, 15
ca = [(achar(j),j=ic(i),ic(i+1)-1)]
table(i,6) = all(is_punctuation(ca))
end do

do i = 1, 15
ca = [(achar(j),j=ic(i),ic(i+1)-1)]
table(i,7) = all(is_alphanum(ca))
end do

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)
do i = 1, 15
ca = [(achar(j),j=ic(i),ic(i+1)-1)]
table(i,8) = all(is_alpha(ca))
end do

do i = 1, 15
ca = [(achar(j),j=ic(i),ic(i+1)-1)]
table(i,9) = all(is_upper(ca))
end do

do i = 1, 15
ca = [(achar(j),j=ic(i),ic(i+1)-1)]
table(i,10) = all(is_lower(ca))
end do

do i = 1, 15
ca = [(achar(j),j=ic(i),ic(i+1)-1)]
table(i,11) = all(is_digit(ca))
end do

do i = 1, 15
ca = [(achar(j),j=ic(i),ic(i+1)-1)]
table(i,12) = all(is_hex_digit(ca))
end do


! Output true/false table for verification
write(*,*)
write(*,'(10X,A)') "is_control"
write(*,'(10X,A)') "| is_printable"
write(*,'(10X,A)') "| | is_whitespace"
write(*,'(10X,A)') "| | | is_blank"
write(*,'(10X,A)') "| | | | is_graphical"
write(*,'(10X,A)') "| | | | | is_punctuation"
write(*,'(10X,A)') "| | | | | | is_alphanum"
write(*,'(10X,A)') "| | | | | | | is_alpha"
write(*,'(10X,A)') "| | | | | | | | is_upper"
write(*,'(10X,A)') "| | | | | | | | | is_lower"
write(*,'(10X,A)') "| | | | | | | | | | is_digit"
write(*,'(A10,A)') " decimal ","| | | | | | | | | | | is_hex_digit"
write(*,*) "-------------------------------------------"
do i = 1, 15
! Process first column
if (ic(i) /= ic(i+1)-1) then
write(col,'(I0,"-",I0)') ic(i), ic(i+1)-1
else
write(col,'(I0)') ic(i)
end if

write(*,'(1X,A7,2X,12(L1,:,X),2X,I3)') adjustr(col), (table(i,j),j=1,12)
end do
end subroutine

end program