223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

make clear that functionality is YAML specific 

'#' as comment sign is not universal
This commit is contained in:
Martin Diehl 2023-12-14 06:23:50 +01:00 committed by achalhp
parent 883aed9092
commit 0eb37fa4c0
2 changed files with 62 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
src/IO.f90
View File

@ -24,7 +24,8 @@ implicit none(type,external)
IO_WHITESPACE = achar(44)//achar(32)//achar(9)//achar(10)//achar(13), & !< whitespace characters IO_WHITESPACE = achar(44)//achar(32)//achar(9)//achar(10)//achar(13), & !< whitespace characters
IO_QUOTES = "'"//'"' IO_QUOTES = "'"//'"'
character, parameter, public :: & character, parameter, public :: &
IO_EOL = LF, & !< end of line character IO_EOL = LF !< end of line character
character, parameter :: &
IO_COMMENT = '#' IO_COMMENT = '#'
public :: & public :: &
@ -39,7 +40,6 @@ implicit none(type,external)
IO_intValue, & IO_intValue, &
IO_realValue, & IO_realValue, &
IO_lc, & IO_lc, &
IO_rmComment, &
IO_glueDiffering, & IO_glueDiffering, &
IO_intAsStr, & IO_intAsStr, &
IO_strAsInt, & IO_strAsInt, &
@ -221,7 +221,7 @@ pure function IO_strPos(str)
character(len=*), intent(in) :: str !< string in which chunk positions are searched for character(len=*), intent(in) :: str !< string in which chunk positions are searched for
integer, dimension(:), allocatable :: IO_strPos integer, dimension(:), allocatable :: IO_strPos
integer :: left, right integer :: left, right
allocate(IO_strPos(1), source=0) allocate(IO_strPos(1), source=0)
@ -230,7 +230,7 @@ pure function IO_strPos(str)
do while (verify(str(right+1:),IO_WHITESPACE)>0) do while (verify(str(right+1:),IO_WHITESPACE)>0)
left = right + verify(str(right+1:),IO_WHITESPACE) left = right + verify(str(right+1:),IO_WHITESPACE)
right = left + scan(str(left:),IO_WHITESPACE) - 2 right = left + scan(str(left:),IO_WHITESPACE) - 2
if ( str(left:left) == IO_COMMENT) exit if (str(left:left) == IO_COMMENT) exit ! ToDo: unexpected and undocumented
IO_strPos = [IO_strPos,left,right] IO_strPos = [IO_strPos,left,right]
IO_strPos(1) = IO_strPos(1)+1 IO_strPos(1) = IO_strPos(1)+1
endOfStr: if (right < left) then endOfStr: if (right < left) then
@ -316,27 +316,6 @@ pure function IO_lc(str)
end function IO_lc end function IO_lc
!--------------------------------------------------------------------------------------------------
! @brief Remove comments (characters beyond '#') and trailing space.
! ToDo: Discuss name (the trim aspect is not clear)
!--------------------------------------------------------------------------------------------------
function IO_rmComment(line)
character(len=*), intent(in) :: line
character(len=:), allocatable :: IO_rmComment
integer :: split
split = index(line,IO_COMMENT)
if (split == 0) then
IO_rmComment = trim(line)
else
IO_rmComment = trim(line(:split-1))
end if
end function IO_rmComment
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -873,19 +852,6 @@ subroutine IO_selfTest()
str='*(HiU!)3';if ('*(hiu!)3' /= IO_lc(str)) error stop 'IO_lc' 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'
if ('abc, def' /= IO_wrapLines('abc, def')) & if ('abc, def' /= IO_wrapLines('abc, def')) &
error stop 'IO_wrapLines/1' error stop 'IO_wrapLines/1'
if ('abc,'//IO_EOL//'def' /= IO_wrapLines('abc,def',length=3)) & if ('abc,'//IO_EOL//'def' /= IO_wrapLines('abc,def',length=3)) &

75
src/YAML.f90
View File

@ -310,8 +310,8 @@ logical function isKeyValue(line)
isKeyValue = .false. isKeyValue = .false.
if ( .not. isKey(line) .and. index(IO_rmComment(line),':') > 0 .and. .not. isFlow(line)) then if ( .not. isKey(line) .and. index(rmComment(line),':') > 0 .and. .not. isFlow(line)) then
if (index(IO_rmComment(line),': ') > 0) isKeyValue = .true. if (index(rmComment(line),': ') > 0) isKeyValue = .true.
end if end if
end function isKeyValue end function isKeyValue
@ -326,11 +326,11 @@ logical function isKey(line)
character(len=*), intent(in) :: line character(len=*), intent(in) :: line
if (len(IO_rmComment(line)) == 0) then if (len(rmComment(line)) == 0) then
isKey = .false. isKey = .false.
else else
isKey = index(IO_rmComment(line),':',back=.false.) == len(IO_rmComment(line)) .and. & isKey = index(rmComment(line),':',back=.false.) == len(rmComment(line)) .and. &
index(IO_rmComment(line),':',back=.true.) == len(IO_rmComment(line)) .and. & index(rmComment(line),':',back=.true.) == len(rmComment(line)) .and. &
.not. isFlow(line) .not. isFlow(line)
end if end if
@ -364,7 +364,7 @@ subroutine skip_empty_lines(blck,s_blck)
empty = .true. empty = .true.
do while (empty .and. len_trim(blck(s_blck:)) /= 0) do while (empty .and. len_trim(blck(s_blck:)) /= 0)
empty = len_trim(IO_rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))) == 0 empty = len_trim(rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))) == 0
if (empty) s_blck = s_blck + index(blck(s_blck:),IO_EOL) if (empty) s_blck = s_blck + index(blck(s_blck:),IO_EOL)
end do end do
@ -383,11 +383,11 @@ subroutine skip_file_header(blck,s_blck)
character(len=:), allocatable :: line character(len=:), allocatable :: line
line = IO_rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2)) line = rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))
if (index(adjustl(line),'%YAML') == 1) then if (index(adjustl(line),'%YAML') == 1) then
s_blck = s_blck + index(blck(s_blck:),IO_EOL) s_blck = s_blck + index(blck(s_blck:),IO_EOL)
call skip_empty_lines(blck,s_blck) call skip_empty_lines(blck,s_blck)
if (trim(IO_rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))) == '---') then if (trim(rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))) == '---') then
s_blck = s_blck + index(blck(s_blck:),IO_EOL) s_blck = s_blck + index(blck(s_blck:),IO_EOL)
else else
call IO_error(708,ext_msg = line) call IO_error(708,ext_msg = line)
@ -443,7 +443,7 @@ subroutine remove_line_break(blck,s_blck,e_char,flow_line)
flow_line = '' flow_line = ''
do while (.not. line_end) do while (.not. line_end)
flow_line = flow_line//IO_rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))//' ' flow_line = flow_line//rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))//' '
line_end = flow_is_closed(flow_line,e_char) line_end = flow_is_closed(flow_line,e_char)
s_blck = s_blck + index(blck(s_blck:),IO_EOL) s_blck = s_blck + index(blck(s_blck:),IO_EOL)
end do end do
@ -466,14 +466,14 @@ subroutine list_item_inline(blck,s_blck,inline,offset)
indent = indentDepth(blck(s_blck:),offset) indent = indentDepth(blck(s_blck:),offset)
line = IO_rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2)) line = rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))
inline = line(indent-offset+3:) inline = line(indent-offset+3:)
s_blck = s_blck + index(blck(s_blck:),IO_EOL) s_blck = s_blck + index(blck(s_blck:),IO_EOL)
indent_next = indentDepth(blck(s_blck:)) indent_next = indentDepth(blck(s_blck:))
do while (indent_next > indent) do while (indent_next > indent)
inline = inline//' '//trim(adjustl(IO_rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2)))) inline = inline//' '//trim(adjustl(rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))))
s_blck = s_blck + index(blck(s_blck:),IO_EOL) s_blck = s_blck + index(blck(s_blck:),IO_EOL)
indent_next = indentDepth(blck(s_blck:)) indent_next = indentDepth(blck(s_blck:))
end do end do
@ -621,7 +621,7 @@ recursive subroutine lst(blck,flow,s_blck,s_flow,offset)
indent = indentDepth(blck(s_blck:),offset) indent = indentDepth(blck(s_blck:),offset)
do while (s_blck <= len_trim(blck)) do while (s_blck <= len_trim(blck))
e_blck = s_blck + index(blck(s_blck:),IO_EOL) - 2 e_blck = s_blck + index(blck(s_blck:),IO_EOL) - 2
line = IO_rmComment(blck(s_blck:e_blck)) line = rmComment(blck(s_blck:e_blck))
if (trim(line) == '---' .or. trim(line) == '...') then if (trim(line) == '---' .or. trim(line) == '...') then
exit exit
elseif (len_trim(line) == 0) then elseif (len_trim(line) == 0) then
@ -640,7 +640,7 @@ recursive subroutine lst(blck,flow,s_blck,s_flow,offset)
s_blck = e_blck + 2 s_blck = e_blck + 2
call skip_empty_lines(blck,s_blck) call skip_empty_lines(blck,s_blck)
e_blck = s_blck + index(blck(s_blck:),IO_EOL) - 2 e_blck = s_blck + index(blck(s_blck:),IO_EOL) - 2
line = IO_rmComment(blck(s_blck:e_blck)) line = rmComment(blck(s_blck:e_blck))
if (trim(line) == '---') call IO_error(707,ext_msg=line) if (trim(line) == '---') call IO_error(707,ext_msg=line)
if (indentDepth(line) < indent .or. indentDepth(line) == indent) & if (indentDepth(line) < indent .or. indentDepth(line) == indent) &
call IO_error(701,ext_msg=line) call IO_error(701,ext_msg=line)
@ -718,7 +718,7 @@ recursive subroutine dct(blck,flow,s_blck,s_flow,offset)
do while (s_blck <= len_trim(blck)) do while (s_blck <= len_trim(blck))
e_blck = s_blck + index(blck(s_blck:),IO_EOL) - 2 e_blck = s_blck + index(blck(s_blck:),IO_EOL) - 2
line = IO_rmComment(blck(s_blck:e_blck)) line = rmComment(blck(s_blck:e_blck))
if (trim(line) == '---' .or. trim(line) == '...') then if (trim(line) == '---' .or. trim(line) == '...') then
exit exit
elseif (len_trim(line) == 0) then elseif (len_trim(line) == 0) then
@ -796,7 +796,7 @@ recursive subroutine decide(blck,flow,s_blck,s_flow,offset)
if (s_blck <= len(blck)) then if (s_blck <= len(blck)) then
call skip_empty_lines(blck,s_blck) call skip_empty_lines(blck,s_blck)
e_blck = s_blck + index(blck(s_blck:),IO_EOL) - 2 e_blck = s_blck + index(blck(s_blck:),IO_EOL) - 2
line = IO_rmComment(blck(s_blck:e_blck)) line = rmComment(blck(s_blck:e_blck))
if (trim(line) == '---' .or. trim(line) == '...') then if (trim(line) == '---' .or. trim(line) == '...') then
continue ! end parsing at this point but not stop the simulation continue ! end parsing at this point but not stop the simulation
elseif (len_trim(line) == 0) then elseif (len_trim(line) == 0) then
@ -854,11 +854,11 @@ function to_flow(blck)
if (len_trim(blck) /= 0) then if (len_trim(blck) /= 0) then
call skip_empty_lines(blck,s_blck) call skip_empty_lines(blck,s_blck)
call skip_file_header(blck,s_blck) call skip_file_header(blck,s_blck)
line = IO_rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2)) line = rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))
if (trim(line) == '---') s_blck = s_blck + index(blck(s_blck:),IO_EOL) if (trim(line) == '---') s_blck = s_blck + index(blck(s_blck:),IO_EOL)
call decide(blck,to_flow,s_blck,s_flow,offset) call decide(blck,to_flow,s_blck,s_flow,offset)
end if end if
line = IO_rmComment(blck(s_blck:s_blck+index(blck(s_blck:),IO_EOL)-2)) line = rmComment(blck(s_blck:s_blck+index(blck(s_blck:),IO_EOL)-2))
if (trim(line)== '---') call IO_warning(709,ext_msg=line) if (trim(line)== '---') call IO_warning(709,ext_msg=line)
to_flow = trim(to_flow(:s_flow-1)) to_flow = trim(to_flow(:s_flow-1))
end_line = index(to_flow,IO_EOL) end_line = index(to_flow,IO_EOL)
@ -867,6 +867,30 @@ function to_flow(blck)
end function to_flow end function to_flow
!--------------------------------------------------------------------------------------------------
! @brief Remove comments (characters beyond '#') and trailing space.
! ToDo: Discuss name (the trim aspect is not clear)
!--------------------------------------------------------------------------------------------------
function rmComment(line)
character(len=*), intent(in) :: line
character(len=:), allocatable :: rmComment
integer :: split
character, parameter :: COMMENT_SIGN = '#'
split = index(line,COMMENT_SIGN)
if (split == 0) then
rmComment = trim(line)
else
rmComment = trim(line(:split-1))
end if
end function rmComment
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Check correctness of some YAML functions. !> @brief Check correctness of some YAML functions.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -1031,6 +1055,23 @@ subroutine YAML_selfTest()
end block parse end block parse
comment: block
character(len=:), allocatable :: str,out
str='#';out=rmComment(str)
if (out /= '' .or. len(out) /= 0) error stop 'rmComment/1'
str=' #';out=rmComment(str)
if (out /= '' .or. len(out) /= 0) error stop 'rmComment/2'
str=' # ';out=rmComment(str)
if (out /= '' .or. len(out) /= 0) error stop 'rmComment/3'
str=' # a';out=rmComment(str)
if (out /= '' .or. len(out) /= 0) error stop 'rmComment/4'
str=' a#';out=rmComment(str)
if (out /= ' a' .or. len(out) /= 2) error stop 'rmComment/5'
str=' ab #';out=rmComment(str)
if (out /= ' ab'.or. len(out) /= 3) error stop 'rmComment/6'
end block comment
end subroutine YAML_selfTest end subroutine YAML_selfTest
#endif #endif