diff --git a/src/YAML.f90 b/src/YAML.f90 index f002b489a..e4a65a7fe 100644 --- a/src/YAML.f90 +++ b/src/YAML.f90 @@ -310,8 +310,8 @@ logical function isKeyValue(line) isKeyValue = .false. - if ( .not. isKey(line) .and. index(rmComment(line),':') > 0 .and. .not. isFlow(line)) then - if (index(rmComment(line),': ') > 0) isKeyValue = .true. + if ( .not. isKey(line) .and. index(clean(line),':') > 0 .and. .not. isFlow(line)) then + if (index(clean(line),': ') > 0) isKeyValue = .true. end if end function isKeyValue @@ -326,11 +326,11 @@ logical function isKey(line) character(len=*), intent(in) :: line - if (len(rmComment(line)) == 0) then + if (len(clean(line)) == 0) then isKey = .false. else - isKey = index(rmComment(line),':',back=.false.) == len(rmComment(line)) .and. & - index(rmComment(line),':',back=.true.) == len(rmComment(line)) .and. & + isKey = index(clean(line),':',back=.false.) == len(clean(line)) .and. & + index(clean(line),':',back=.true.) == len(clean(line)) .and. & .not. isFlow(line) end if @@ -364,7 +364,7 @@ subroutine skip_empty_lines(blck,s_blck) empty = .true. do while (empty .and. len_trim(blck(s_blck:)) /= 0) - empty = len_trim(rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))) == 0 + empty = len_trim(clean(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) end do @@ -383,11 +383,11 @@ subroutine skip_file_header(blck,s_blck) character(len=:), allocatable :: line - line = rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2)) + line = clean(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2)) if (index(adjustl(line),'%YAML') == 1) then s_blck = s_blck + index(blck(s_blck:),IO_EOL) call skip_empty_lines(blck,s_blck) - if (trim(rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))) == '---') then + if (trim(clean(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))) == '---') then s_blck = s_blck + index(blck(s_blck:),IO_EOL) else call IO_error(708,ext_msg = line) @@ -443,7 +443,7 @@ subroutine remove_line_break(blck,s_blck,e_char,flow_line) flow_line = '' do while (.not. line_end) - flow_line = flow_line//rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))//' ' + flow_line = flow_line//clean(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))//' ' line_end = flow_is_closed(flow_line,e_char) s_blck = s_blck + index(blck(s_blck:),IO_EOL) end do @@ -466,14 +466,14 @@ subroutine list_item_inline(blck,s_blck,inline,offset) indent = indentDepth(blck(s_blck:),offset) - line = rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2)) + line = clean(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2)) inline = line(indent-offset+3:) s_blck = s_blck + index(blck(s_blck:),IO_EOL) indent_next = indentDepth(blck(s_blck:)) do while (indent_next > indent) - inline = inline//' '//trim(adjustl(rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2)))) + inline = inline//' '//trim(adjustl(clean(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2)))) s_blck = s_blck + index(blck(s_blck:),IO_EOL) indent_next = indentDepth(blck(s_blck:)) end do @@ -621,7 +621,7 @@ recursive subroutine lst(blck,flow,s_blck,s_flow,offset) indent = indentDepth(blck(s_blck:),offset) do while (s_blck <= len_trim(blck)) e_blck = s_blck + index(blck(s_blck:),IO_EOL) - 2 - line = rmComment(blck(s_blck:e_blck)) + line = clean(blck(s_blck:e_blck)) if (trim(line) == '---' .or. trim(line) == '...') then exit 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 call skip_empty_lines(blck,s_blck) e_blck = s_blck + index(blck(s_blck:),IO_EOL) - 2 - line = rmComment(blck(s_blck:e_blck)) + line = clean(blck(s_blck:e_blck)) if (trim(line) == '---') call IO_error(707,ext_msg=line) if (indentDepth(line) < indent .or. indentDepth(line) == indent) & 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)) e_blck = s_blck + index(blck(s_blck:),IO_EOL) - 2 - line = rmComment(blck(s_blck:e_blck)) + line = clean(blck(s_blck:e_blck)) if (trim(line) == '---' .or. trim(line) == '...') then exit 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 call skip_empty_lines(blck,s_blck) e_blck = s_blck + index(blck(s_blck:),IO_EOL) - 2 - line = rmComment(blck(s_blck:e_blck)) + line = clean(blck(s_blck:e_blck)) if (trim(line) == '---' .or. trim(line) == '...') then continue ! end parsing at this point but not stop the simulation elseif (len_trim(line) == 0) then @@ -854,11 +854,11 @@ function to_flow(blck) if (len_trim(blck) /= 0) then call skip_empty_lines(blck,s_blck) call skip_file_header(blck,s_blck) - line = rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2)) + line = clean(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) call decide(blck,to_flow,s_blck,s_flow,offset) end if - line = rmComment(blck(s_blck:s_blck+index(blck(s_blck:),IO_EOL)-2)) + line = clean(blck(s_blck:s_blck+index(blck(s_blck:),IO_EOL)-2)) if (trim(line)== '---') call IO_warning(709,ext_msg=line) to_flow = trim(to_flow(:s_flow-1)) end_line = index(to_flow,IO_EOL) @@ -869,26 +869,25 @@ end function to_flow !-------------------------------------------------------------------------------------------------- ! @brief Remove comments (characters beyond '#') and trailing space. -! ToDo: Discuss name (the trim aspect is not clear) !-------------------------------------------------------------------------------------------------- -function rmComment(line) +function clean(line) character(len=*), intent(in) :: line - character(len=:), allocatable :: rmComment + character(len=:), allocatable :: clean integer :: split - character, parameter :: COMMENT_SIGN = '#' + character, parameter :: COMMENT_CHAR = '#' - split = index(line,COMMENT_SIGN) + split = index(line,COMMENT_CHAR) if (split == 0) then - rmComment = trim(line) + clean = trim(line) else - rmComment = trim(line(:split-1)) + clean = trim(line(:split-1)) end if -end function rmComment +end function clean !-------------------------------------------------------------------------------------------------- @@ -1058,18 +1057,18 @@ subroutine YAML_selfTest() 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' + str='#';out=clean(str) + if (out /= '' .or. len(out) /= 0) error stop 'clean/1' + str=' #';out=clean(str) + if (out /= '' .or. len(out) /= 0) error stop 'clean/2' + str=' # ';out=clean(str) + if (out /= '' .or. len(out) /= 0) error stop 'clean/3' + str=' # a';out=clean(str) + if (out /= '' .or. len(out) /= 0) error stop 'clean/4' + str=' a#';out=clean(str) + if (out /= ' a' .or. len(out) /= 2) error stop 'clean/5' + str=' ab #';out=clean(str) + if (out /= ' ab'.or. len(out) /= 3) error stop 'clean/6' end block comment end subroutine YAML_selfTest