64 implicit none;
private
70 operator(.contains.), &
113 character(:),
allocatable :: chars
116 procedure, pass(lhs),
private :: character_assign_string
117 procedure, pass(rhs),
private :: string_assign_character
118 procedure, pass(lhs),
private :: string_eq_string
119 procedure, pass(lhs),
private :: string_eq_character
120 procedure, pass(rhs),
private :: character_eq_string
121 procedure, pass(dtv),
private :: write_formatted
123 generic,
public ::
assignment(=) => character_assign_string, &
124 string_assign_character
125 generic,
public ::
operator(==) => string_eq_string, &
126 string_eq_character, &
128 generic,
public ::
write(formatted) => write_formatted
136 module procedure :: string_len
144 module procedure :: string_len_trim
152 module procedure :: string_trim
159 interface operator(//)
160 module procedure :: string_concat_string
161 module procedure :: string_concat_character
162 module procedure :: character_concat_string
169 interface operator(.contains.)
170 module procedure :: strings_contain_string
171 module procedure :: strings_contain_character
172 module procedure :: characters_contain_string
173 module procedure :: characters_contain_character
181 module procedure :: index_string_string
182 module procedure :: index_string_character
183 module procedure :: index_character_string
200 subroutine character_assign_string(lhs, rhs)
201 class(string),
intent(inout) :: lhs
202 character(*),
intent(in) :: rhs
204 if (
allocated(lhs%chars))
deallocate(lhs%chars)
205 allocate(lhs%chars, source=rhs)
223 subroutine string_assign_character(lhs, rhs)
224 character(:),
allocatable,
intent(inout) :: lhs
225 class(string),
intent(in) :: rhs
245 elemental integer function string_len(this)
result(res)
246 class(
string),
intent(in) :: this
248 if (
allocated(this%chars))
then
249 res =
len(this%chars)
270 pure integer function string_len_trim(this)
result(res)
271 class(
string),
intent(in) :: this
273 if (
allocated(this%chars))
then
285 pure function string_trim(this)
result(res)
286 class(
string),
intent(in) :: this
287 character(:),
allocatable :: res
289 if (
allocated(this%chars))
then
290 res =
trim(this%chars)
302 pure function string_concat_string(lhs, rhs)
result(res)
303 class(
string),
intent(in) :: lhs
304 class(
string),
intent(in) :: rhs
305 character(:),
allocatable :: res
307 if (
allocated(lhs%chars) .and.
allocated(rhs%chars))
then
308 res = lhs%chars // rhs%chars
309 elseif (
allocated(lhs%chars))
then
311 elseif (
allocated(rhs%chars))
then
324 pure function string_concat_character(lhs, rhs)
result(res)
325 class(
string),
intent(in) :: lhs
326 character(*),
intent(in) :: rhs
327 character(:),
allocatable :: res
329 if (
allocated(lhs%chars))
then
330 res = lhs%chars // rhs
342 pure function character_concat_string(lhs, rhs)
result(res)
343 character(*),
intent(in) :: lhs
344 class(
string),
intent(in) :: rhs
345 character(:),
allocatable :: res
347 if (
allocated(rhs%chars))
then
348 res = lhs // rhs%chars
360 elemental function string_eq_string(lhs, rhs)
result(res)
361 class(
string),
intent(in) :: lhs
362 class(
string),
intent(in) :: rhs
365 if (.not.
allocated(lhs%chars))
then
366 res =
allocated(rhs%chars)
368 res = lhs%chars == rhs%chars
378 elemental function string_eq_character(lhs, rhs)
result(res)
379 class(
string),
intent(in) :: lhs
380 character(*),
intent(in) :: rhs
383 if (.not.
allocated(lhs%chars))
then
386 res = lhs%chars == rhs
396 elemental function character_eq_string(lhs, rhs)
result(res)
397 character(*),
intent(in) :: lhs
398 class(
string),
intent(in) :: rhs
401 if (.not.
allocated(rhs%chars))
then
404 res = rhs%chars == lhs
448 subroutine write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
449 class(
string),
intent(in) :: dtv
450 integer,
intent(in) :: unit
451 character(*),
intent(in) :: iotype
452 integer,
intent(in) :: v_list(:)
453 integer,
intent(out) :: iostat
454 character(*),
intent(inout) :: iomsg
456 if (
allocated(dtv%chars))
then
457 write(unit,
'(A)', iostat=iostat, iomsg=iomsg) dtv%chars
459 write(unit,
'(A)', iostat=iostat, iomsg=iomsg)
''
500 character(*),
intent(in) :: str
501 character(*),
intent(in) :: arg1
502 integer,
intent(out),
optional :: idx
508 if (
present(idx)) idx = i
517 character function head(str)
result(res)
518 character(*),
intent(in) :: str
532 character function tail(str)
result(res)
533 character(*),
intent(in) :: str
551 character(*),
intent(in) :: str1
552 character(*),
intent(in) :: str2
553 character(:),
allocatable :: res
557 n1 =
len(str1); n2 = 1
558 if (
head(str1) ==
'!')
then
568 if (
head(adjustl(str2(n2:))) ==
'&')
then
569 n2 =
index(str2,
'&') + 1
574 if (
tail(str1(:n1)) ==
'(') n1 =
index(str1(:n1),
'(', back=.true.)
577 if (
len(str1) > 0 .and.
len(str2) >= n2)
then
578 if (str1(n1:n1) ==
' ' .and. str2(n2:n2) ==
' ') n2 = n2 + 1
580 res = str1(:n1) // str2(n2:)
598 character(*),
intent(in) :: str
599 character(len_trim(str)) :: res
601 integer :: ilen, ioffset, iquote, iqc, iav, i
604 ioffset = iachar(
'A') - iachar(
'a')
608 iav = iachar(str(i:i))
609 if (iquote == 0 .and. (iav == 34 .or. iav == 39))
then
614 if (iquote == 1 .and. iav == iqc)
then
618 if (iquote == 1) cycle
619 if (iav >= iachar(
'a') .and. iav <= iachar(
'z'))
then
620 res(i:i) = achar(iav + ioffset)
642 character(*),
intent(in) :: str
643 character(len_trim(str)) :: res
645 integer :: ilen, ioffset, iquote, iqc, iav, i
648 ioffset = iachar(
'A') - iachar(
'a')
652 iav = iachar(str(i:i))
653 if (iquote == 0 .and. (iav == 34 .or. iav == 39))
then
658 if (iquote == 1 .and. iav == iqc)
then
662 if (iquote == 1) cycle
663 if (iav >= iachar(
'A') .and. iav <= iachar(
'Z'))
then
664 res(i:i) = achar(iav - ioffset)
678 integer,
intent(in) :: unit
679 character(*),
intent(in) :: str
684 if (
head(str) /=
'!')
then
690 write(unit,
'(A)') str(n *
chksize + 1:)
700 character(1) function previous(line, pos)
result(res)
701 character(*),
intent(in) :: line
702 integer,
intent(inout) :: pos
706 res =
trim(line(pos:pos))
708 do while (line(pos:pos) ==
' ')
722 logical function strings_contain_string(lhs, rhs)
result(res)
723 type(
string),
intent(in) :: lhs(:)
724 type(
string),
intent(in) :: rhs
730 if (lhs(i) == rhs)
then
743 logical function strings_contain_character(lhs, rhs)
result(res)
744 type(
string),
intent(in) :: lhs(:)
745 character(*),
intent(in) :: rhs
751 if (lhs(i) == rhs)
then
764 logical function characters_contain_character(lhs, rhs)
result(res)
765 character(*),
intent(in) :: lhs(:)
766 character(*),
intent(in) :: rhs
772 if (lhs(i) == rhs)
then
785 logical function characters_contain_string(lhs, rhs)
result(res)
786 character(*),
intent(in) :: lhs(:)
787 type(
string),
intent(in) :: rhs
793 if (lhs(i) == rhs)
then
800 integer function index_string_string(str, substr, back)
result(res)
801 class(
string),
intent(in) :: str
802 class(
string),
intent(in) :: substr
803 logical,
intent(in),
optional :: back
805 res =
index(str%chars, substr%chars, back=back)
808 integer function index_character_string(str, substr, back)
result(res)
809 character(*),
intent(in) :: str
810 class(
string),
intent(in) :: substr
811 logical,
intent(in),
optional :: back
813 res =
index(str, substr%chars, back=back)
816 integer function index_string_character(str, substr, back)
result(res)
817 class(
string),
intent(in) :: str
818 character(*),
intent(in) :: substr
819 logical,
intent(in),
optional :: back
821 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...