Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit 3832d5e

Browse files
committed
Revert "refactor test"
This reverts commit 4bc022d.
1 parent 11dd81e commit 3832d5e

File tree

1 file changed

+60
-40
lines changed

1 file changed

+60
-40
lines changed

‎test/ascii/test_ascii.f90

Lines changed: 60 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -726,10 +726,66 @@ subroutine test_to_upper_long(error)
726726
! This test reproduces the true/false table found at
727727
! https://en.cppreference.com/w/cpp/string/byte
728728
!
729+
subroutine ascii_table(table)
730+
logical, intent(out) :: table(15,12)
731+
integer :: i, j
732+
733+
! loop through functions
734+
do i = 1, 12
735+
table(1,i) = all([(validate(j,i), j=0,8)])
736+
table(2,i) = validate(9,i)
737+
table(3,i) = all([(validate(j,i), j=10,13)])
738+
table(4,i) = all([(validate(j,i), j=14,31)])
739+
table(5,i) = validate(32,i)
740+
table(6,i) = all([(validate(j,i), j=33,47)])
741+
table(7,i) = all([(validate(j,i), j=48,57)])
742+
table(8,i) = all([(validate(j,i), j=58,64)])
743+
table(9,i) = all([(validate(j,i), j=65,70)])
744+
table(10,i) = all([(validate(j,i), j=71,90)])
745+
table(11,i) = all([(validate(j,i), j=91,96)])
746+
table(12,i) = all([(validate(j,i), j=97,102)])
747+
table(13,i) = all([(validate(j,i), j=103,122)])
748+
table(14,i) = all([(validate(j,i), j=123,126)])
749+
table(15,i) = validate(127,i)
750+
end do
751+
752+
! output table for verification
753+
write(*,'(5X,12(I4))') (i,i=1,12)
754+
do j = 1, 15
755+
write(*,'(I3,2X,12(L4),2X,I3)') j, (table(j,i),i=1,12), count(table(j,:))
756+
end do
757+
write(*,'(5X,12(I4))') (count(table(:,i)),i=1,12)
758+
759+
contains
760+
761+
elemental logical function validate(ascii_code, func)
762+
integer, intent(in) :: ascii_code, func
763+
character(len=1) :: c
764+
765+
c = achar(ascii_code)
766+
767+
select case (func)
768+
case (1); validate = is_control(c)
769+
case (2); validate = is_printable(c)
770+
case (3); validate = is_white(c)
771+
case (4); validate = is_blank(c)
772+
case (5); validate = is_graphical(c)
773+
case (6); validate = is_punctuation(c)
774+
case (7); validate = is_alphanum(c)
775+
case (8); validate = is_alpha(c)
776+
case (9); validate = is_upper(c)
777+
case (10); validate = is_lower(c)
778+
case (11); validate = is_digit(c)
779+
case (12); validate = is_hex_digit(c)
780+
case default; validate = .false.
781+
end select
782+
end function validate
783+
784+
end subroutine ascii_table
785+
729786
subroutine test_ascii_table(error)
730787
type(error_type), allocatable, intent(out) :: error
731-
integer :: i, j
732-
logical :: table(15,12)
788+
logical :: arr(15, 12)
733789
logical, parameter :: ascii_class_table(15,12) = transpose(reshape([ &
734790
! iscntrl isprint isspace isblank isgraph ispunct isalnum isalpha isupper islower isdigit isxdigit
735791
.true., .false., .false., .false., .false., .false., .false., .false., .false., .false., .false., .false., & ! 0–8
@@ -749,44 +805,8 @@ subroutine test_ascii_table(error)
749805
.true., .false., .false., .false., .false., .false., .false., .false., .false., .false., .false., .false. & ! 127
750806
], shape=[12,15]))
751807

752-
type :: list
753-
character(1), allocatable :: chars(:)
754-
end type
755-
type(list) :: tests(15)
756-
757-
tests(1)%chars = [(achar(j),j=0,8)] ! control codes
758-
tests(2)%chars = [(achar(j),j=9,9)] ! tab
759-
tests(3)%chars = [(achar(j),j=10,13)] ! whitespaces
760-
tests(4)%chars = [(achar(j),j=14,31)] ! control codes
761-
tests(5)%chars = [(achar(j),j=32,32)] ! space
762-
tests(6)%chars = [(achar(j),j=33,47)] ! !"#$%&'()*+,-./
763-
tests(7)%chars = [(achar(j),j=48,57)] ! 0123456789
764-
tests(8)%chars = [(achar(j),j=58,64)] ! :;<=>?@
765-
tests(9)%chars = [(achar(j),j=65,70)] ! ABCDEF
766-
tests(10)%chars = [(achar(j),j=71,90)] ! GHIJKLMNOPQRSTUVWXYZ
767-
tests(11)%chars = [(achar(j),j=91,96)] ! [\]^_`
768-
tests(12)%chars = [(achar(j),j=97,102)] ! abcdef
769-
tests(13)%chars = [(achar(j),j=103,122)]! ghijklmnopqrstuvwxyz
770-
tests(14)%chars = [(achar(j),j=123,126)]! {|}~
771-
tests(15)%chars = [(achar(j),j=127,127)]! backspace character
772-
773-
! loop through functions
774-
do i = 1, 15
775-
table(i,1) = all(is_control(tests(i)%chars))
776-
table(i,2) = all(is_printable(tests(i)%chars))
777-
table(i,3) = all(is_white(tests(i)%chars))
778-
table(i,4) = all(is_blank(tests(i)%chars))
779-
table(i,5) = all(is_graphical(tests(i)%chars))
780-
table(i,6) = all(is_punctuation(tests(i)%chars))
781-
table(i,7) = all(is_alphanum(tests(i)%chars))
782-
table(i,8) = all(is_alpha(tests(i)%chars))
783-
table(i,9) = all(is_upper(tests(i)%chars))
784-
table(i,10) = all(is_lower(tests(i)%chars))
785-
table(i,11) = all(is_digit(tests(i)%chars))
786-
table(i,12) = all(is_hex_digit(tests(i)%chars))
787-
end do
788-
789-
call check(error, all(table .eqv. ascii_class_table), "ascii table was not accurately generated")
808+
call ascii_table(arr)
809+
call check(error, all(arr .eqv. ascii_class_table), "ascii table was not accurately generated")
790810

791811
end subroutine test_ascii_table
792812

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /