refactor test

Author: jalvesz

test/ascii/test_ascii.f90

@@ -726,66 +726,10 @@ subroutine test_to_upper_long(error)
     !   This test reproduces the true/false table found at
     !   https://en.cppreference.com/w/cpp/string/byte
     !
-    subroutine ascii_table(table)
-        logical, intent(out) :: table(15,12)
-        integer :: i, j
-
-        ! loop through functions
-        do i = 1, 12
-            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
-        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)
- 
-        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 ascii_table
-
     subroutine test_ascii_table(error)
         type(error_type), allocatable, intent(out) :: error
-        logical :: arr(15, 12)
+        integer :: i, j
+        logical :: table(15,12)
         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
@@ -805,8 +749,44 @@ subroutine test_ascii_table(error)
         .true.,   .false., .false., .false., .false., .false., .false., .false., .false., .false., .false., .false.  & ! 127
         ], shape=[12,15]))
 
-        call ascii_table(arr)
-        call check(error, all(arr .eqv. ascii_class_table), "ascii table was not accurately generated")
+        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, 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
+
+        call check(error, all(table .eqv. ascii_class_table), "ascii table was not accurately generated")
 
     end subroutine test_ascii_table