| Class | dcstring_base |
| In: |
src/dcstring_base.f90
|
解説
本モジュールはポインタが使えない環境で 508 字までの
可変長文字列を保持する構造体を提供する。
| extract_string : | type(VSTRING) |
| string : | type(VSTRING), intent(in) |
| start : | integer, intent(in), optional |
| finish : | integer, intent(in), optional |
— 新設手続 —
type(VSTRING) function extract_string(string, start, finish)
type(VSTRING), intent(in):: string
integer, intent(in), optional:: start, finish
integer:: first, last
continue
first = 1
if (present(start)) first = max(start, first)
last = len(string)
if (present(finish)) last = min(finish, last)
extract_string = string%body(first: last)
end function
| str : | type(VSTRING), intent(out) |
| maxlen : | integer, intent(in), optional |
| iostat : | integer, intent(out), optional |
入出力
subroutine string_get_default(str, maxlen, iostat)
type(VSTRING), intent(out):: str
integer, intent(in), optional:: maxlen
integer, intent(out), optional:: iostat
continue
call string_get(-1, str, maxlen, iostat)
end subroutine
| unit : | integer, intent(in) |
| str : | type(VSTRING), intent(out) |
| maxlen : | integer, intent(in), optional |
| iostat : | integer, intent(out), optional |
入出力
subroutine string_get(unit, str, maxlen, iostat)
integer, intent(in):: unit
type(VSTRING), intent(out):: str
integer, intent(in), optional:: maxlen
integer, intent(out), optional:: iostat
integer:: alreadyread, buflen, nowread, ios, maxsize
integer, parameter:: BUFFERSIZE = 80
character(len = BUFFERSIZE):: buffer
continue
if (present(maxlen)) then
maxsize = min(maxlen, STRING_MAX)
else
maxsize = STRING_MAX
endif
alreadyread = 0
str = ''
do
if (alreadyread >= maxsize) return
buflen = min(BUFFERSIZE, maxsize - alreadyread)
! SUPER-UX 対策
buffer = ''
! 読み取り
if (unit >= 0) then
read(unit=unit, fmt='(A)', advance='NO', size=nowread, eor=100, iostat=ios) buffer(1: buflen)
else
read(unit=*, fmt='(A)', advance='NO', size=nowread, eor=100, iostat=ios) buffer(1: buflen)
endif
if (ios /= 0) then
if (present(iostat)) then
iostat = ios
return
else
print *, 'get_string: read error ', ios
stop
endif
endif
! なぜか SUPER-UX SX4 Fortran 90 では行末でこうなる
if (nowread == 0 .and. len_trim(buffer) /= 0) then
nowread = len_trim(buffer)
goto 100
endif
alreadyread = alreadyread + nowread
str = str // buffer(1: nowread)
enddo
if (present(iostat)) iostat = 0
return
! in case of EOR
100 continue
str = str // buffer(1: nowread)
if (present(iostat)) iostat = 0
end subroutine string_get
| result : | integer |
| str : | type(VSTRING), intent(in) |
総称 len 関数の実体
integer function string_len(str) result(result)
type(VSTRING), intent(in):: str
continue
result = str%len
end function
| unit : | integer, intent(in) |
| str : | type(VSTRING), intent(in) |
| iostat : | integer, intent(out), optional |
入出力
subroutine string_put(unit, str, iostat)
integer, intent(in):: unit
type(VSTRING), intent(in):: str
integer, intent(out), optional:: iostat
integer:: ios
continue
if (unit >= 0) then
write(unit=unit, fmt='(A)', advance='NO', iostat=ios) str%body(1:str%len)
else
write(unit=*, fmt='(A)', advance='NO', iostat=ios) str%body(1:str%len)
endif
if (present(iostat)) then
iostat = ios
else
if (ios /= 0) then
print *, 'string_put: write error ', ios
endif
endif
end subroutine
| str : | type(VSTRING), intent(in) |
| iostat : | integer, intent(out), optional |
入出力
subroutine string_put_default(str, iostat)
type(VSTRING), intent(in):: str
integer, intent(out), optional:: iostat
continue
call string_put(-1, str, iostat)
end subroutine
| unit : | integer, intent(in) |
| char : | character(len=*), intent(in) |
| iostat : | integer, intent(out), optional |
入出力
subroutine char_put(unit, char, iostat)
integer, intent(in):: unit
character(len=*), intent(in):: char
integer, intent(out), optional:: iostat
integer:: ios
continue
if (unit >= 0) then
write(unit=unit, fmt='(A)', advance='NO', iostat=ios) char
else
write(unit=*, fmt='(A)', advance='NO', iostat=ios) char
endif
if (present(iostat)) then
iostat = ios
else
if (ios /= 0) then
print *, 'char_put: write error ', ios
endif
endif
end subroutine
| char : | character(len=*), intent(in) |
| iostat : | integer, intent(out), optional |
入出力
subroutine char_put_default(char, iostat)
character(len=*), intent(in):: char
integer, intent(out), optional:: iostat
continue
call char_put(-1, char, iostat)
end subroutine
| char : | character(len=*), intent(in) |
| iostat : | integer, intent(out), optional |
入出力
subroutine char_put_line_default(char, iostat)
character(len=*), intent(in):: char
integer, intent(out), optional:: iostat
continue
call char_put_line(-1, char, iostat)
end subroutine
| unit : | integer, intent(in) |
| char : | character(len=*), intent(in) |
| iostat : | integer, intent(out), optional |
入出力
subroutine char_put_line(unit, char, iostat)
integer, intent(in):: unit
character(len=*), intent(in):: char
integer, intent(out), optional:: iostat
integer:: ios
continue
if (unit >= 0) then
write(unit=unit, fmt='(A)', advance='YES', iostat=ios) char
else
write(unit=*, fmt='(A)', advance='YES', iostat=ios) char
endif
if (present(iostat)) then
iostat = ios
else
if (ios /= 0) then
print *, 'char_put_line: write error ', ios
endif
endif
end subroutine
| str : | type(VSTRING), intent(in) |
| iostat : | integer, intent(out), optional |
入出力
subroutine string_put_line_default(str, iostat)
type(VSTRING), intent(in):: str
integer, intent(out), optional:: iostat
continue
call string_put_line(-1, str, iostat)
end subroutine
| unit : | integer, intent(in) |
| str : | type(VSTRING), intent(in) |
| iostat : | integer, intent(out), optional |
入出力
subroutine string_put_line(unit, str, iostat)
integer, intent(in):: unit
type(VSTRING), intent(in):: str
integer, intent(out), optional:: iostat
integer:: ios
continue
if (unit >= 0) then
write(unit=unit, fmt='(A)', advance='YES', iostat=ios) str%body(1:str%len)
else
write(unit=*, fmt='(A)', advance='YES', iostat=ios) str%body(1:str%len)
endif
if (present(iostat)) then
iostat = ios
else
if (ios /= 0) then
print *, 'string_put_line: write error ', ios
endif
endif
end subroutine
| string : | type(VSTRING), intent(inout) |
| word : | type(VSTRING), intent(out) |
| set : | type(VSTRING), intent(in) |
| separator : | type(VSTRING), intent(out), optional |
| back : | logical, intent(in), optional |
subroutine split_s(string, word, set, separator, back)
type(VSTRING), intent(inout):: string
type(VSTRING), intent(out):: word
type(VSTRING), intent(in):: set
type(VSTRING), intent(out), optional:: separator
logical, intent(in), optional:: back
continue
call split_c(string, word, vchar(set, len(set)), separator, back)
end subroutine
| string : | type(VSTRING), intent(inout) |
| word : | type(VSTRING), intent(out) |
| set : | character(len = *), intent(in) |
| separator : | type(VSTRING), intent(out), optional |
| back : | logical, intent(in), optional |
subroutine split_c(string, word, set, separator, back)
type(VSTRING), intent(inout):: string
type(VSTRING), intent(out):: word
character(len = *), intent(in):: set
type(VSTRING), intent(out), optional:: separator
logical, intent(in), optional:: back
logical:: backward
integer:: is, endword
continue
backward = .FALSE.
if (present(back)) backward = back
if (backward) then
find_backward: do, endword = len(string), 1, -1
do, is = 1, len(set)
if (element(string, endword) == set(is:is)) exit find_backward
enddo
enddo find_backward
word = extract(string, endword)
if (present(separator)) then
if (endword == 0) then
separator = ""
else
separator = element(string, endword)
endif
endif
call shorten(string, len(string) - 1)
else
find_forward: do, endword = 1, len(string)
do, is = 1, len(set)
if (element(string, endword) == set(is:is)) exit find_forward
enddo
enddo find_forward
word = extract(string, 1, endword-1)
if (present(separator)) then
if (endword > len(string)) then
separator = ""
else
separator = element(string, endword)
endif
endif
call left_shift(string, endword)
endif
end subroutine
| result : | type(VSTRING) |
| char : | character(len=*), intent(in) |
総称 var_str 関数の実体
type(VSTRING) function char_to_string(char) result(result)
character(len=*), intent(in):: char
interface
end interface
continue
if (len(char) > STRING_MAX) call dcstringbase_warnlim('cast')
result%len = min(len(char), STRING_MAX)
result%body = char
end function
| result : | character(len = length) |
| str : | type(VSTRING), intent(in) |
| length : | integer, intent(in) |
総称 vchar 関数の実体
function string_to_char_length(str, length) result(result)
type(VSTRING), intent(in):: str
integer, intent(in):: length
character(len = length):: result
continue
call char_let_string(result, str)
end function
| result : | integer |
| str : | type(VSTRING), intent(in) |
| substring : | character(len = *), intent(in) |
| back : | logical, intent(in), optional |
function string_index_char(str, substring, back) result(result)
integer:: result
type(VSTRING), intent(in):: str
character(len = *), intent(in):: substring
logical, intent(in), optional:: back
logical:: backward
integer:: index
intrinsic index
continue
backward = .FALSE.
if (present(back)) backward = back
result = index(str%body(1:str%len), substring, backward)
end function
| result : | integer |
| str : | type(VSTRING), intent(in) |
| substring : | type(VSTRING), intent(in) |
| back : | logical, intent(in), optional |
function string_index_string(str, substring, back) result(result)
integer:: result
type(VSTRING), intent(in):: str, substring
logical, intent(in), optional:: back
logical:: backward
integer:: index
intrinsic index
continue
backward = .FALSE.
if (present(back)) backward = back
result = index(str%body(1:str%len), substring%body(1:substring%len), backward)
end function
| result : | integer |
| str : | character(len = *), intent(in) |
| substring : | type(VSTRING), intent(in) |
| back : | logical, intent(in), optional |
function char_index_string(str, substring, back) result(result)
integer:: result
character(len = *), intent(in):: str
type(VSTRING), intent(in):: substring
logical, intent(in), optional:: back
logical:: backward
continue
backward = .FALSE.
if (present(back)) backward = back
result = index(str, substring%body(1:substring%len), backward)
end function
| result : | integer |
| str : | type(VSTRING), intent(in) |
| set : | type(VSTRING), intent(in) |
| back : | logical, optional |
function string_scan_string(str, set, back) result(result)
integer:: result
type(VSTRING), intent(in):: str, set
logical, optional:: back
logical:: backward
continue
backward = .FALSE.
if (present(back)) backward = back
result = scan(str%body(1:str%len), set%body(1:set%len), backward)
end function
| result : | integer |
| str : | type(VSTRING), intent(in) |
| set : | character(len = *), intent(in) |
| back : | logical, optional |
function string_scan_char(str, set, back) result(result)
integer:: result
type(VSTRING), intent(in):: str
character(len = *), intent(in):: set
logical, optional:: back
logical:: backward
continue
backward = .FALSE.
if (present(back)) backward = back
result = scan(str%body(1:str%len), set, backward)
end function
| result : | integer |
| string : | type(VSTRING), intent(in) |
| set : | character(len = *), intent(in) |
| back : | logical, optional |
function string_verify_char(string, set, back) result(result)
integer:: result
type(VSTRING), intent(in):: string
character(len = *), intent(in):: set
logical, optional:: back
logical:: backward
intrinsic verify
continue
backward = .FALSE.
if (present(back)) backward = back
result = verify(string%body(1:string%len), set, backward)
end function
| result : | integer |
| string : | type(VSTRING), intent(in) |
| set : | type(VSTRING), intent(in) |
| back : | logical, optional |
function string_verify_string(string, set, back) result(result)
integer:: result
type(VSTRING), intent(in):: string, set
logical, optional:: back
logical:: b
intrinsic verify
continue
b = .FALSE.
if (present(back)) b = back
result = verify(string%body(1:string%len), set%body(1:set%len), b)
end function