@@ -721,6 +721,67 @@ subroutine test_to_upper_long(error)
721721 end do
722722 end subroutine
723723
724+ !
725+ ! This test reproduces the true/false table found at
726+ ! https://en.cppreference.com/w/cpp/string/byte
727+ !
728+ subroutine test_ascii_table
729+ integer :: i, j
730+ logical :: table(15 ,12 )
731+ 732+ ! loop through functions
733+ do i = 1 , 12
734+ table(1 ,i) = all ([(validate(j,i), j= 0 ,8 )])
735+ table(2 ,i) = validate(9 ,i)
736+ table(3 ,i) = all ([(validate(j,i), j= 10 ,13 )])
737+ table(4 ,i) = all ([(validate(j,i), j= 14 ,31 )])
738+ table(5 ,i) = validate(32 ,i)
739+ table(6 ,i) = all ([(validate(j,i), j= 33 ,47 )])
740+ table(7 ,i) = all ([(validate(j,i), j= 48 ,57 )])
741+ table(8 ,i) = all ([(validate(j,i), j= 58 ,64 )])
742+ table(9 ,i) = all ([(validate(j,i), j= 65 ,70 )])
743+ table(10 ,i) = all ([(validate(j,i), j= 71 ,90 )])
744+ table(11 ,i) = all ([(validate(j,i), j= 91 ,96 )])
745+ table(12 ,i) = all ([(validate(j,i), j= 97 ,102 )])
746+ table(13 ,i) = all ([(validate(j,i), j= 103 ,122 )])
747+ table(14 ,i) = all ([(validate(j,i), j= 123 ,126 )])
748+ table(15 ,i) = validate(127 ,i)
749+ end do
750+ 751+ ! output table for verification
752+ write (* ,' (5X,12(I4))' = 1 ,12 )
753+ do j = 1 , 15
754+ write (* ,' (I3,2X,12(L4),2X,I3)' = 1 ,12 ), count (table(j,:))
755+ end do
756+ write (* ,' (5X,12(I4))' count (table(:,i)),i= 1 ,12 )
757+ 758+ contains
759+ 760+ elemental logical function validate(ascii_code, func)
761+ integer , intent (in ) :: ascii_code, func
762+ character (len= 1 ) :: c
763+ 764+ c = achar (ascii_code)
765+ 766+ select case (func)
767+ case (1 ); validate = is_control(c)
768+ case (2 ); validate = is_printable(c)
769+ case (3 ); validate = is_white(c)
770+ case (4 ); validate = is_blank(c)
771+ case (5 ); validate = is_graphical(c)
772+ case (6 ); validate = is_punctuation(c)
773+ case (7 ); validate = is_alphanum(c)
774+ case (8 ); validate = is_alpha(c)
775+ case (9 ); validate = is_upper(c)
776+ case (10 ); validate = is_lower(c)
777+ case (11 ); validate = is_digit(c)
778+ case (12 ); validate = is_hex_digit(c)
779+ case default ; validate = .false.
780+ end select
781+ end function validate
782+ 783+ end subroutine test_ascii_table
784+ 724785 subroutine test_to_lower_string (error )
725786 ! > Error handling
726787 type (error_type), allocatable , intent (out ) :: error
0 commit comments