From 11834bc65bf4e47b0813e492ea91c5868c413005 Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Sat, 21 Sep 2024 00:59:17 -0400 Subject: [PATCH] need high resolution in codebase --- src/M_strings.F90 | 2 +- test/test_suite_M_strings.f90 | 17 +++++++++++++++++ 2 files changed, 18 insertions(+), 1 deletion(-) diff --git a/src/M_strings.F90 b/src/M_strings.F90 index ff282871..ad1677c7 100755 --- a/src/M_strings.F90 +++ b/src/M_strings.F90 @@ -10518,7 +10518,7 @@ logical function codebase(inval10,outbase,answer) integer,intent(in) :: outbase character(len=*),intent(out) :: answer integer :: n -real :: inval10_local +real(kind=real64) :: inval10_local integer :: outbase_local integer :: in_sign answer='' diff --git a/test/test_suite_M_strings.f90 b/test/test_suite_M_strings.f90 index 49c94a5a..35164ed5 100755 --- a/test/test_suite_M_strings.f90 +++ b/test/test_suite_M_strings.f90 @@ -510,6 +510,9 @@ end subroutine test_base2 subroutine test_codebase() character(len=:),allocatable :: in(:) integer,allocatable :: expected(:) +character(len=80) :: answer, baseformat, expect +integer :: i, j, base, ierr +logical :: ier call unit_test_start('codebase','[BASE] convert whole number in base 10 to string in base [2-36]') ! convert base10 values to base2 strings @@ -523,6 +526,20 @@ subroutine test_codebase() call checkit(['123123'],[1755],4) call checkit(['10'],[16],16) call checkit(['10'],[8],8) + ! test against Fortran BOZ values + do j=1,3 + select case(j) + case(1); base=2; baseformat='(b0)' + case(2); base=8; baseformat='(o0)' + case(3); base=16; baseformat='(z0)' + end select + do i=0,huge(0),1237 + ier=codebase(i,base,answer) + write(expect,baseformat)i + if(answer.ne.expect.or..not.ier) & + & call unit_test('codebase',F,'expected',expect,'got',answer) + enddo + enddo call unit_test_end('codebase') contains