63 implicit none;
private
69 operator(.contains.), &
111 character(:),
allocatable :: chars
114 procedure, pass(lhs),
private :: character_assign_string
115 procedure, pass(rhs),
private :: string_assign_character
116 procedure, pass(lhs),
private :: string_eq_string
117 procedure, pass(lhs),
private :: string_eq_character
118 procedure, pass(rhs),
private :: character_eq_string
119 procedure, pass(dtv),
private :: write_formatted
121 generic,
public ::
assignment(=) => character_assign_string, &
122 string_assign_character
123 generic,
public ::
operator(==) => string_eq_string, &
124 string_eq_character, &
126 generic,
public ::
write(formatted) => write_formatted
134 module procedure :: string_len
142 module procedure :: string_len_trim
150 module procedure :: string_trim
157 interface operator(//)
158 module procedure :: string_concat_string
159 module procedure :: string_concat_character
160 module procedure :: character_concat_string
167 interface operator(.contains.)
168 module procedure :: strings_contain_string
169 module procedure :: strings_contain_character
170 module procedure :: characters_contain_string
171 module procedure :: characters_contain_character
179 module procedure :: index_string_string
180 module procedure :: index_string_character
181 module procedure :: index_character_string
198 subroutine character_assign_string(lhs, rhs)
199 class(
string),
intent(inout) :: lhs
200 character(*),
intent(in) :: rhs
202 if (
allocated(lhs%chars))
deallocate(lhs%chars)
203 allocate(lhs%chars, source=rhs)
221 subroutine string_assign_character(lhs, rhs)
222 character(:),
allocatable,
intent(inout) :: lhs
223 class(
string),
intent(in) :: rhs
243 elemental integer function string_len(this)
result(res)
244 class(
string),
intent(in) :: this
246 if (
allocated(this%chars))
then
247 res =
len(this%chars)
268 pure integer function string_len_trim(this)
result(res)
269 class(
string),
intent(in) :: this
271 if (
allocated(this%chars))
then
283 pure function string_trim(this)
result(res)
284 class(
string),
intent(in) :: this
285 character(:),
allocatable :: res
287 if (
allocated(this%chars))
then
288 res =
trim(this%chars)
300 pure function string_concat_string(lhs, rhs)
result(res)
301 class(
string),
intent(in) :: lhs
302 class(
string),
intent(in) :: rhs
303 character(:),
allocatable :: res
305 if (
allocated(lhs%chars) .and.
allocated(rhs%chars))
then
306 res = lhs%chars // rhs%chars
307 elseif (
allocated(lhs%chars))
then
309 elseif (
allocated(rhs%chars))
then
322 pure function string_concat_character(lhs, rhs)
result(res)
323 class(
string),
intent(in) :: lhs
324 character(*),
intent(in) :: rhs
325 character(:),
allocatable :: res
327 if (
allocated(lhs%chars))
then
328 res = lhs%chars // rhs
340 pure function character_concat_string(lhs, rhs)
result(res)
341 character(*),
intent(in) :: lhs
342 class(
string),
intent(in) :: rhs
343 character(:),
allocatable :: res
345 if (
allocated(rhs%chars))
then
346 res = lhs // rhs%chars
358 elemental function string_eq_string(lhs, rhs)
result(res)
359 class(
string),
intent(in) :: lhs
360 class(
string),
intent(in) :: rhs
363 if (.not.
allocated(lhs%chars))
then
364 res =
allocated(rhs%chars)
366 res = lhs%chars == rhs%chars
376 elemental function string_eq_character(lhs, rhs)
result(res)
377 class(
string),
intent(in) :: lhs
378 character(*),
intent(in) :: rhs
381 if (.not.
allocated(lhs%chars))
then
384 res = lhs%chars == rhs
394 elemental function character_eq_string(lhs, rhs)
result(res)
395 character(*),
intent(in) :: lhs
396 class(
string),
intent(in) :: rhs
399 if (.not.
allocated(rhs%chars))
then
402 res = rhs%chars == lhs
446 subroutine write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
447 class(
string),
intent(in) :: dtv
448 integer,
intent(in) :: unit
449 character(*),
intent(in) :: iotype
450 integer,
intent(in) :: v_list(:)
451 integer,
intent(out) :: iostat
452 character(*),
intent(inout) :: iomsg
454 if (
allocated(dtv%chars))
then
455 write(unit,
'(A)', iostat=iostat, iomsg=iomsg) dtv%chars
457 write(unit,
'(A)', iostat=iostat, iomsg=iomsg)
''
498 character(*),
intent(in) :: str
499 character(*),
intent(in) :: arg1
500 integer,
intent(out),
optional :: idx
506 if (
present(idx)) idx = i
515 character function head(str)
result(res)
516 character(*),
intent(in) :: str
530 character function tail(str)
result(res)
531 character(*),
intent(in) :: str
549 character(*),
intent(in) :: str1
550 character(*),
intent(in) :: str2
551 character(:),
allocatable :: res
555 n1 =
len(str1); n2 = 1
556 if (
head(str1) ==
'!')
then
566 if (
head(adjustl(str2(n2:))) ==
'&')
then
567 n2 =
index(str2,
'&') + 1
572 if (
tail(str1(:n1)) ==
'(') n1 =
index(str1(:n1),
'(', back=.true.)
575 if (
len(str1) > 0 .and.
len(str2) >= n2)
then
576 if (str1(n1:n1) ==
' ' .and. str2(n2:n2) ==
' ') n2 = n2 + 1
578 res = str1(:n1) // str2(n2:)
596 character(*),
intent(in) :: str
597 character(len_trim(str)) :: res
599 integer :: ilen, ioffset, iquote, iqc, iav, i
602 ioffset = iachar(
'A') - iachar(
'a')
606 iav = iachar(str(i:i))
607 if (iquote == 0 .and. (iav == 34 .or. iav == 39))
then
612 if (iquote == 1 .and. iav == iqc)
then
616 if (iquote == 1) cycle
617 if (iav >= iachar(
'a') .and. iav <= iachar(
'z'))
then
618 res(i:i) = achar(iav + ioffset)
640 character(*),
intent(in) :: str
641 character(len_trim(str)) :: res
643 integer :: ilen, ioffset, iquote, iqc, iav, i
646 ioffset = iachar(
'A') - iachar(
'a')
650 iav = iachar(str(i:i))
651 if (iquote == 0 .and. (iav == 34 .or. iav == 39))
then
656 if (iquote == 1 .and. iav == iqc)
then
660 if (iquote == 1) cycle
661 if (iav >= iachar(
'A') .and. iav <= iachar(
'Z'))
then
662 res(i:i) = achar(iav - ioffset)
676 integer,
intent(in) :: unit
677 character(*),
intent(in) :: str
682 if (
head(str) /=
'!')
then
688 write(unit,
'(A)') str(n *
chksize + 1:)
698 character(1) function previous(line, pos)
result(res)
699 character(*),
intent(in) :: line
700 integer,
intent(inout) :: pos
704 res =
trim(line(pos:pos))
706 do while (line(pos:pos) ==
' ')
720 logical function strings_contain_string(lhs, rhs)
result(res)
721 type(
string),
intent(in) :: lhs(:)
722 type(
string),
intent(in) :: rhs
728 if (lhs(i) == rhs)
then
741 logical function strings_contain_character(lhs, rhs)
result(res)
742 type(
string),
intent(in) :: lhs(:)
743 character(*),
intent(in) :: rhs
749 if (lhs(i) == rhs)
then
762 logical function characters_contain_character(lhs, rhs)
result(res)
763 character(*),
intent(in) :: lhs(:)
764 character(*),
intent(in) :: rhs
770 if (lhs(i) == rhs)
then
783 logical function characters_contain_string(lhs, rhs)
result(res)
784 character(*),
intent(in) :: lhs(:)
785 type(
string),
intent(in) :: rhs
791 if (lhs(i) == rhs)
then
798 integer function index_string_string(str, substr, back)
result(res)
799 class(
string),
intent(in) :: str
800 class(
string),
intent(in) :: substr
801 logical,
intent(in),
optional :: back
803 res =
index(str%chars, substr%chars, back=back)
806 integer function index_character_string(str, substr, back)
result(res)
807 character(*),
intent(in) :: str
808 class(
string),
intent(in) :: substr
809 logical,
intent(in),
optional :: back
811 res =
index(str, substr%chars, back=back)
814 integer function index_string_character(str, substr, back)
result(res)
815 class(
string),
intent(in) :: str
816 character(*),
intent(in) :: substr
817 logical,
intent(in),
optional :: back
819 res =
index(str%chars, substr, back=back)
integer, parameter, public chksize
Maximum chunk size.
character function, public tail(str)
Returns the last non-blank character of a string.
pure character(len_trim(str)) function, public lowercase(str)
Convert string to lower case (respects contents of quotes).
subroutine, public writechk(unit, str)
Write a long line split into chunks of size CHKSIZE with continuation (&).
character(1) function, public previous(line, pos)
Returns the previous non-blank character before position pos (updates pos).
pure character(len_trim(str)) function, public uppercase(str)
Convert string to upper case (respects contents of quotes).
character(:) function, allocatable, public concat(str1, str2)
Smart concatenation that removes continuation markers (&) and handles line-continuation rules.
logical function, public starts_with(str, arg1, idx)
Checks if a string starts with a given prefix Returns .true. if the string str (after trimming leadin...
character function, public head(str)
Returns the first non-blank character of a string.
Return the trimmed length of a string.
Return the length of a string.
Return the trimmed string.
Represents text as a sequence of ASCII code units. The derived type wraps an allocatable character ar...