more verbose and specific messaging in self-test and errors

This commit is contained in:
Philip Eisenlohr 2022-10-27 15:24:36 -04:00
parent 94849d9c38
commit 5c688345ed
2 changed files with 72 additions and 57 deletions

View File

@ -36,6 +36,7 @@ module IO
IO_floatValue, &
IO_lc, &
IO_rmComment, &
IO_intAsString, &
IO_stringAsInt, &
IO_stringAsFloat, &
IO_stringAsBool, &
@ -253,11 +254,7 @@ pure function IO_lc(string)
do i=1,len(string)
n = index(UPPER,string(i:i))
if (n/=0) then
IO_lc(i:i) = LOWER(n:n)
else
IO_lc(i:i) = string(i:i)
end if
IO_lc(i:i) = merge(string(i:i),LOWER(n:n),n==0)
end do
end function IO_lc
@ -285,6 +282,21 @@ function IO_rmComment(line)
end function IO_rmComment
!--------------------------------------------------------------------------------------------------
!> @brief Return given int value as string.
!--------------------------------------------------------------------------------------------------
function IO_intAsString(i)
integer, intent(in) :: i
character(len=:), allocatable :: IO_intAsString
allocate(character(len=merge(2,1,i<0) + floor(log10(real(abs(merge(1,i,i==0))))))::IO_intAsString)
write(IO_intAsString,'(i0)') i
end function IO_intAsString
!--------------------------------------------------------------------------------------------------
!> @brief Return integer value from given string.
!--------------------------------------------------------------------------------------------------
@ -527,7 +539,7 @@ subroutine IO_error(error_ID,ext_msg,label1,ID1,label2,ID2)
msg = 'MPI error'
case (950)
msg = 'max number of cut back exceeded, terminating'
msg = 'max number of cutbacks exceeded, terminating'
case default
error stop 'invalid error number'
@ -665,66 +677,69 @@ end subroutine panel
subroutine selfTest()
integer, dimension(:), allocatable :: chunkPos
character(len=:), allocatable :: str
character(len=:), allocatable :: str,out
if(dNeq(1.0_pReal, IO_stringAsFloat('1.0'))) error stop 'IO_stringAsFloat'
if(dNeq(1.0_pReal, IO_stringAsFloat('1e0'))) error stop 'IO_stringAsFloat'
if(dNeq(0.1_pReal, IO_stringAsFloat('1e-1'))) error stop 'IO_stringAsFloat'
if(dNeq(0.1_pReal, IO_stringAsFloat('1.0e-1'))) error stop 'IO_stringAsFloat'
if(dNeq(0.1_pReal, IO_stringAsFloat('1.00e-1'))) error stop 'IO_stringAsFloat'
if(dNeq(10._pReal, IO_stringAsFloat(' 1.0e+1 '))) error stop 'IO_stringAsFloat'
if (dNeq(1.0_pReal, IO_stringAsFloat('1.0'))) error stop 'IO_stringAsFloat'
if (dNeq(1.0_pReal, IO_stringAsFloat('1e0'))) error stop 'IO_stringAsFloat'
if (dNeq(0.1_pReal, IO_stringAsFloat('1e-1'))) error stop 'IO_stringAsFloat'
if (dNeq(0.1_pReal, IO_stringAsFloat('1.0e-1'))) error stop 'IO_stringAsFloat'
if (dNeq(0.1_pReal, IO_stringAsFloat('1.00e-1'))) error stop 'IO_stringAsFloat'
if (dNeq(10._pReal, IO_stringAsFloat(' 1.0e+1 '))) error stop 'IO_stringAsFloat'
if(3112019 /= IO_stringAsInt( '3112019')) error stop 'IO_stringAsInt'
if(3112019 /= IO_stringAsInt(' 3112019')) error stop 'IO_stringAsInt'
if(-3112019 /= IO_stringAsInt('-3112019')) error stop 'IO_stringAsInt'
if(3112019 /= IO_stringAsInt('+3112019 ')) error stop 'IO_stringAsInt'
if(3112019 /= IO_stringAsInt('03112019 ')) error stop 'IO_stringAsInt'
if(3112019 /= IO_stringAsInt('+03112019')) error stop 'IO_stringAsInt'
if (3112019 /= IO_stringAsInt( '3112019')) error stop 'IO_stringAsInt'
if (3112019 /= IO_stringAsInt(' 3112019')) error stop 'IO_stringAsInt'
if (-3112019 /= IO_stringAsInt('-3112019')) error stop 'IO_stringAsInt'
if (3112019 /= IO_stringAsInt('+3112019 ')) error stop 'IO_stringAsInt'
if (3112019 /= IO_stringAsInt('03112019 ')) error stop 'IO_stringAsInt'
if (3112019 /= IO_stringAsInt('+03112019')) error stop 'IO_stringAsInt'
if(.not. IO_stringAsBool(' true')) error stop 'IO_stringAsBool'
if(.not. IO_stringAsBool(' True ')) error stop 'IO_stringAsBool'
if( IO_stringAsBool(' false')) error stop 'IO_stringAsBool'
if( IO_stringAsBool('False')) error stop 'IO_stringAsBool'
if (.not. IO_stringAsBool(' true')) error stop 'IO_stringAsBool'
if (.not. IO_stringAsBool(' True ')) error stop 'IO_stringAsBool'
if ( IO_stringAsBool(' false')) error stop 'IO_stringAsBool'
if ( IO_stringAsBool('False')) error stop 'IO_stringAsBool'
if(any([1,1,1] /= IO_stringPos('a'))) error stop 'IO_stringPos'
if(any([2,2,3,5,5] /= IO_stringPos(' aa b'))) error stop 'IO_stringPos'
if ('1234' /= IO_intAsString(1234)) error stop 'IO_intAsString'
if ('-12' /= IO_intAsString(-0012)) error stop 'IO_intAsString'
if (any([1,1,1] /= IO_stringPos('a'))) error stop 'IO_stringPos'
if (any([2,2,3,5,5] /= IO_stringPos(' aa b'))) error stop 'IO_stringPos'
str = ' 1.0 xxx'
chunkPos = IO_stringPos(str)
if(dNeq(1.0_pReal,IO_floatValue(str,chunkPos,1))) error stop 'IO_floatValue'
if (dNeq(1.0_pReal,IO_floatValue(str,chunkPos,1))) error stop 'IO_floatValue'
str='M 3112019 F'
str = 'M 3112019 F'
chunkPos = IO_stringPos(str)
if(3112019 /= IO_intValue(str,chunkPos,2)) error stop 'IO_intValue'
if (3112019 /= IO_intValue(str,chunkPos,2)) error stop 'IO_intValue'
if (CRLF2LF('') /= '') error stop 'CRLF2LF/0'
if (CRLF2LF(LF) /= LF) error stop 'CRLF2LF/1a'
if (CRLF2LF(CR//LF) /= LF) error stop 'CRLF2LF/1b'
if (CRLF2LF(' '//LF) /= ' '//LF) error stop 'CRLF2LF/2a'
if (CRLF2LF(' '//CR//LF) /= ' '//LF) error stop 'CRLF2LF/2b'
if (CRLF2LF('A'//CR//LF//'B') /= 'A'//LF//'B') error stop 'CRLF2LF/3'
if (CRLF2LF('') /= '') error stop 'CRLF2LF/0'
if (CRLF2LF(LF) /= LF) error stop 'CRLF2LF/1a'
if (CRLF2LF(CR//LF) /= LF) error stop 'CRLF2LF/1b'
if (CRLF2LF(' '//LF) /= ' '//LF) error stop 'CRLF2LF/2a'
if (CRLF2LF(' '//CR//LF) /= ' '//LF) error stop 'CRLF2LF/2b'
if (CRLF2LF('A'//CR//LF//'B') /= 'A'//LF//'B') error stop 'CRLF2LF/3'
if (CRLF2LF('A'//CR//LF//'B'//CR//LF) /= &
'A'//LF//'B'//LF) error stop 'CRLF2LF/4'
'A'//LF//'B'//LF) error stop 'CRLF2LF/4'
if(.not. IO_isBlank(' ')) error stop 'IO_isBlank/1'
if(.not. IO_isBlank(' #isBlank')) error stop 'IO_isBlank/2'
if( IO_isBlank(' i#s')) error stop 'IO_isBlank/3'
str=' '; if (.not. IO_isBlank(str)) error stop 'IO_isBlank/1'
str=' #isBlank';if (.not. IO_isBlank(str)) error stop 'IO_isBlank/2'
str=' i#s'; if ( IO_isBlank(str)) error stop 'IO_isBlank/3'
str = IO_rmComment('#')
if (str /= '' .or. len(str) /= 0) error stop 'IO_rmComment/1'
str = IO_rmComment(' #')
if (str /= '' .or. len(str) /= 0) error stop 'IO_rmComment/2'
str = IO_rmComment(' # ')
if (str /= '' .or. len(str) /= 0) error stop 'IO_rmComment/3'
str = IO_rmComment(' # a')
if (str /= '' .or. len(str) /= 0) error stop 'IO_rmComment/4'
str = IO_rmComment(' # a')
if (str /= '' .or. len(str) /= 0) error stop 'IO_rmComment/5'
str = IO_rmComment(' a#')
if (str /= ' a' .or. len(str) /= 2) error stop 'IO_rmComment/6'
str = IO_rmComment(' ab #')
if (str /= ' ab'.or. len(str) /= 3) error stop 'IO_rmComment/7'
str='*(HiU!)3';if ('*(hiu!)3' /= IO_lc(str)) error stop 'IO_lc'
str='#';out=IO_rmComment(str)
if (out /= '' .or. len(out) /= 0) error stop 'IO_rmComment/1'
str=' #';out=IO_rmComment(str)
if (out /= '' .or. len(out) /= 0) error stop 'IO_rmComment/2'
str=' # ';out=IO_rmComment(str)
if (out /= '' .or. len(out) /= 0) error stop 'IO_rmComment/3'
str=' # a';out=IO_rmComment(str)
if (out /= '' .or. len(out) /= 0) error stop 'IO_rmComment/4'
str=' a#';out=IO_rmComment(str)
if (out /= ' a' .or. len(out) /= 2) error stop 'IO_rmComment/5'
str=' ab #';out=IO_rmComment(str)
if (out /= ' ab'.or. len(out) /= 3) error stop 'IO_rmComment/6'
end subroutine selfTest

View File

@ -484,7 +484,7 @@ function tList_as2dFloat(self)
do i=1,self%length
row_data => self%get_list(i)
if (row_data%length /= size(tList_as2dFloat,2)) call IO_error(709,ext_msg='Varying number of columns')
if (row_data%length /= size(tList_as2dFloat,2)) call IO_error(709,ext_msg='inconsistent column count in tList_as2dFloat')
tList_as2dFloat(i,:) = self%get_as1dFloat(i)
end do
@ -614,13 +614,13 @@ function tList_get(self,i) result(node)
class(tList), intent(in), target :: self
integer, intent(in) :: i
class(tNode), pointer :: node
class(tNode), pointer :: node
class(tItem), pointer :: item
class(tItem), pointer :: item
integer :: j
if (i < 1 .or. i > self%length) call IO_error(150,ext_msg='tList_get')
if (i < 1 .or. i > self%length) call IO_error(150,ext_msg='tList_get @ '//IO_intAsString(i))
item => self%first
do j = 2,i
item => item%next
@ -935,7 +935,7 @@ function tDict_key(self,i) result(key)
type(tItem), pointer :: item
if (i < 1 .or. i > self%length) call IO_error(150,ext_msg='tDict_key')
if (i < 1 .or. i > self%length) call IO_error(150,ext_msg='tDict_key @ '//IO_intAsString(i))
item => self%first
do j = 1, i-1
item => item%next