@@ -721,66 +721,6 @@ 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- abstract interface
733- pure logical function validation_func_interface(c)
734- character (len= 1 ), intent (in ) :: c
735- end function
736- end interface
737-
738- type :: proc_pointer_array
739- procedure (validation_func_interface), pointer , nopass :: pcf
740- end type proc_pointer_array
741-
742- type (proc_pointer_array) :: pcfs(12 )
743-
744- pcfs(1 )% pcf = > is_control
745- pcfs(2 )% pcf = > is_printable
746- pcfs(3 )% pcf = > is_white
747- pcfs(4 )% pcf = > is_blank
748- pcfs(5 )% pcf = > is_graphical
749- pcfs(6 )% pcf = > is_punctuation
750- pcfs(7 )% pcf = > is_alphanum
751- pcfs(8 )% pcf = > is_alpha
752- pcfs(9 )% pcf = > is_upper
753- pcfs(10 )% pcf = > is_lower
754- pcfs(11 )% pcf = > is_digit
755- pcfs(12 )% pcf = > is_hex_digit
756-
757- ! loop through functions
758- do i = 1 , 12
759- table(1 ,i) = all ([(pcfs(i)% pcf(achar (j)),j= 0 ,8 )]) ! control codes
760- table(2 ,i) = pcfs(i)% pcf(achar (9 )) ! tab
761- table(3 ,i) = all ([(pcfs(i)% pcf(achar (j)),j= 10 ,13 )]) ! whitespaces
762- table(4 ,i) = all ([(pcfs(i)% pcf(achar (j)),j= 14 ,31 )]) ! control codes
763- table(5 ,i) = pcfs(i)% pcf(achar (32 )) ! space
764- table(6 ,i) = all ([(pcfs(i)% pcf(achar (j)),j= 33 ,47 )]) ! !"#$%&'()*+,-./
765- table(7 ,i) = all ([(pcfs(i)% pcf(achar (j)),j= 48 ,57 )]) ! 0123456789
766- table(8 ,i) = all ([(pcfs(i)% pcf(achar (j)),j= 58 ,64 )]) ! :;<=>?@
767- table(9 ,i) = all ([(pcfs(i)% pcf(achar (j)),j= 65 ,70 )]) ! ABCDEF
768- table(10 ,i) = all ([(pcfs(i)% pcf(achar (j)),j= 71 ,90 )]) ! GHIJKLMNOPQRSTUVWXYZ
769- table(11 ,i) = all ([(pcfs(i)% pcf(achar (j)),j= 91 ,96 )]) ! [\]^_`
770- table(12 ,i) = all ([(pcfs(i)% pcf(achar (j)),j= 97 ,102 )]) ! abcdef
771- table(13 ,i) = all ([(pcfs(i)% pcf(achar (j)),j= 103 ,122 )]) ! ghijklmnopqrstuvwxyz
772- table(14 ,i) = all ([(pcfs(i)% pcf(achar (j)),j= 123 ,126 )]) ! {|}~
773- table(15 ,i) = pcfs(i)% pcf(achar (127 )) ! backspace character
774- end do
775-
776- ! output table for verification
777- write (* ,' (5X,12(I4))' ) (i,i= 1 ,12 )
778- do j = 1 , 15
779- write (* ,' (I3,2X,12(L4),2X,I3)' ) j, (table(j,i),i= 1 ,12 ), count (table(j,:))
780- end do
781- write (* ,' (5X,12(I4))' ) (count (table(:,i)),i= 1 ,12 )
782- end subroutine test_ascii_table
783-
784724 subroutine test_to_lower_string (error )
785725 ! > Error handling
786726 type (error_type), allocatable , intent (out ) :: error
0 commit comments