Loading...
Searching...
No Matches
string.f90
Go to the documentation of this file.
1!> @file
2!! @defgroup group_string String
3!! Minimal yet powerful variable-length string type with modern Fortran features.
4!! This module implements a lightweight `string` derived type that behaves like
5!! a true variable-length character string while remaining fully compatible with
6!! intrinsic Fortran character operations.
7!!
8!! Features:
9!! - Automatic memory management via `allocatable character(:)`
10!! - Overloaded assignment (`=`) between `string` and `character(*)`
11!! - Overloaded operators: `//` (concatenation), `==` (equality), `.contains.` (membership)
12!! - Generic interfaces for `len`, `len_trim`, `trim`
13!! - Full support for formatted I/O (`write`, `print`)
14!! - Helper routines for parsing Fortran source (line continuation, upper/lower case conversion, etc.)
15!!
16!! The design is intentionally minimal — it provides only what's necessary for
17!! robust string handling in scientific and preprocessing applications,
18!! avoiding the bloat of larger string libraries while remaining fast and standards-compliant.
19!! @note All procedures are `pure` or `elemental` when possible for maximum performance
20!! and usability in array contexts.
21!!
22!! <h2 class="groupheader">Examples</h2>
23!! @par Basic Usage
24!! @code{.f90}
25!! type(string) :: s, t
26!! character(:), allocatable :: line
27!!
28!! s = 'Hello' ! Assignment from literal
29!! t = s // ' World!' ! Concatenation
30!! print *, t%chars ! Output: Hello World!
31!!
32!! if (s == 'Hello') then
33!! print *, 'Equal'
34!! else
35!! print *, 'Case sensitive'
36!! endif
37!!
38!! print *, len(t) ! -> 12
39!! print *, len_trim(t) ! -> 12
40!! ...
41!! @endcode
42!!
43!! @par Array and Container Support
44!! @code{.f90}
45!! type(string) :: words(3)
46!! logical :: found
47!!
48!! words = [string('apple'), string('banana'), string('cherry')]
49!! found = words .contains. 'banana' ! --> .true.
50!! found = words .contains. string('date') ! --> .false.
51!! ...
52!! @endcode
53!!
54!! @par Advanced: Source Code Processing
55!! @code{.f90}
56!! character(len=:), allocatable :: code_line
57!! code_line = uppercase('program hello_world ! comment') ! --> 'PROGRAM HELLO_WORLD ! comment'
58!! ...
59!! @endcode
60module fpx_string
61 use fpx_constants
62
63 implicit none; private
64
65 public :: len, &
66 len_trim, &
67 trim, &
68 operator(//), &
69 operator(.contains.), &
70 index
71
72 public :: starts_with, &
73 head, &
74 tail, &
75 previous, &
76 concat, &
77 writechk, &
78 uppercase, &
80
81 !> Represents text as a sequence of ASCII code units.
82 !! The derived type wraps an allocatable character array.
83 !!
84 !! <h2 class="groupheader">Examples</h2>
85 !! @code{.f90}
86 !! type(string) :: s
87 !! s = 'foo'
88 !! @endcode
89 !!
90 !! <h2 class="groupheader">Constructors</h2>
91 !! Initializes a new instance of the string class
92 !! <h3>string(character(:))</h3>
93 !! @verbatim type(string) function string(character(:) chars) @endverbatim
94 !!
95 !! @param[in] chars
96 !!
97 !! @b Examples
98 !! @code{.f90}
99 !! type(string) :: s
100 !! s = string('foo')
101 !! @endcode
102 !! @return The constructed string object.
103 !!
104 !! <h2 class="groupheader">Remarks</h2>
105 !! The string implementation proposed here is kept at the bare
106 !! minimum of what is required by the library. There are many
107 !! other implementations that can be found.
108 !!
109 !! @ingroup group_string
110 type, public :: string
111 character(:), allocatable :: chars !< Variable length character array
112 contains
113 !! @cond
114 procedure, pass(lhs), private :: character_assign_string
115 procedure, pass(rhs), private :: string_assign_character
116 procedure, pass(lhs), private :: string_eq_string !! Equal to string logical operator.
117 procedure, pass(lhs), private :: string_eq_character !! Equal to character logical operator.
118 procedure, pass(rhs), private :: character_eq_string !! Equal to character (inverted) logical operator.
119 procedure, pass(dtv), private :: write_formatted !! Formatted output.
120 !! @endcond
121 generic, public :: assignment(=) => character_assign_string, &
122 string_assign_character
123 generic, public :: operator(==) => string_eq_string, &
124 string_eq_character, &
125 character_eq_string
126 generic, public :: write(formatted) => write_formatted
127 end type
128
129 !> Return the length of a string
130 !!
131 !! @b Remarks
132 !! @ingroup group_string
133 interface len
134 module procedure :: string_len
135 end interface
136
137 !> Return the trimmed length of a string
138 !!
139 !! @b Remarks
140 !! @ingroup group_string
141 interface len_trim
142 module procedure :: string_len_trim
143 end interface
144
145 !> Return the trimmed string
146 !!
147 !! @b Remarks
148 !! @ingroup group_string
149 interface trim
150 module procedure :: string_trim
151 end interface
152
153 !> Concatenation operator
154 !!
155 !! @b Remarks
156 !! @ingroup group_string
157 interface operator(//)
158 module procedure :: string_concat_string
159 module procedure :: string_concat_character
160 module procedure :: character_concat_string
161 end interface
162
163 !> Check whether a string belongs to a list or not
164 !!
165 !! @b Remarks
166 !! @ingroup group_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
172 end interface
173
174 !> Index operator
175 !!
176 !! @b Remarks
177 !! @ingroup group_string
178 interface index
179 module procedure :: index_string_string
180 module procedure :: index_string_character
181 module procedure :: index_character_string
182 end interface
183
184contains
185
186 !> Assignment overloading. Assign a character array to a string.
187 !! @param[inout] lhs string
188 !! @param[in] rhs character(*)
189 !!
190 !! @b Examples
191 !! @code{.f90}
192 !! type(string) :: s
193 !!
194 !! s = 'foo'
195 !! @endcode
196 !!
197 !! @b Remarks
198 subroutine character_assign_string(lhs, rhs)
199 class(string), intent(inout) :: lhs
200 character(*), intent(in) :: rhs
201
202 if (allocated(lhs%chars)) deallocate(lhs%chars)
203 allocate(lhs%chars, source=rhs)
204 end subroutine
205
206 !> Assignment overloading. Assign a string to a character array.
207 !! @param[inout] lhs character(:), allocatable
208 !! @param[in] rhs string
209 !!
210 !! @b Examples
211 !! @code{.f90}
212 !! type(string) :: s
213 !! character(:), allocatable :: c
214 !!
215 !! s = 'foo'
216 !! c = s
217 !! ! The value of c is now 'foo'
218 !! @endcode
219 !!
220 !! @b Remarks
221 subroutine string_assign_character(lhs, rhs)
222 character(:), allocatable, intent(inout) :: lhs
223 class(string), intent(in) :: rhs
224
225 lhs = rhs%chars
226 end subroutine
227
228 !> Length of the string entity.
229 !! @param[in] this string
230 !!
231 !! @b Examples
232 !! @code{.f90}
233 !! type(string) :: s
234 !! integer :: l
235 !!
236 !! s = string('foo ')
237 !! l = len(s)
238 !! ! The value of l is 4
239 !! @endcode
240 !! @return An integer corresponding to the length of the string.
241 !!
242 !! @b Remarks
243 elemental integer function string_len(this) result(res)
244 class(string), intent(in) :: this
245
246 if (allocated(this%chars)) then
247 res = len(this%chars)
248 else
249 res = 0
250 end if
251 end function
252
253 !> Length of the string entity without trailing blanks (len_trim).
254 !! @param[in] this string
255 !!
256 !! @b Examples
257 !! @code{.f90}
258 !! type(string) :: s
259 !! integer :: l
260 !!
261 !! s = string('foo ')
262 !! l = len_trim(s)
263 !! ! The value of l is 3
264 !! @endcode
265 !! @return An integer corresponding to the trimmed length of the string.
266 !!
267 !! @b Remarks
268 pure integer function string_len_trim(this) result(res)
269 class(string), intent(in) :: this
270
271 if (allocated(this%chars)) then
272 res = len_trim(this%chars)
273 else
274 res = 0
275 end if
276 end function
277
278 !> Returns a copy of the string with trailing blanks removed.
279 !! @param[in] this string
280 !! @return Trimmed character string (deferred length).
281 !!
282 !! @b Remarks
283 pure function string_trim(this) result(res)
284 class(string), intent(in) :: this
285 character(:), allocatable :: res
286
287 if (allocated(this%chars)) then
288 res = trim(this%chars)
289 else
290 res = ''
291 end if
292 end function
293
294 !> Concatenation of two string objects.
295 !! @param[in] lhs left-hand side string
296 !! @param[in] rhs right-hand side string
297 !! @return New concatenated string.
298 !!
299 !! @b Remarks
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
304
305 if (allocated(lhs%chars) .and. allocated(rhs%chars)) then
306 res = lhs%chars // rhs%chars
307 elseif (allocated(lhs%chars)) then
308 res = lhs%chars
309 elseif (allocated(rhs%chars)) then
310 res = rhs%chars
311 else
312 res = ''
313 end if
314 end function
315
316 !> Concatenation of string and character expression.
317 !! @param[in] lhs string
318 !! @param[in] rhs character expression
319 !! @return New concatenated string.
320 !!
321 !! @b Remarks
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
326
327 if (allocated(lhs%chars)) then
328 res = lhs%chars // rhs
329 else
330 res = rhs
331 end if
332 end function
333
334 !> Concatenation of character expression and string.
335 !! @param[in] lhs character expression
336 !! @param[in] rhs string
337 !! @return New concatenated string.
338 !!
339 !! @b Remarks
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
344
345 if (allocated(rhs%chars)) then
346 res = lhs // rhs%chars
347 else
348 res = lhs
349 end if
350 end function
351
352 !> Equality comparison between two string objects.
353 !! @param[in] lhs left-hand side
354 !! @param[in] rhs right-hand side
355 !! @return .true. if the strings are equal, .false. otherwise.
356 !!
357 !! @b Remarks
358 elemental function string_eq_string(lhs, rhs) result(res)
359 class(string), intent(in) :: lhs !! Left hand side.
360 class(string), intent(in) :: rhs !! Right hand side.
361 logical :: res !! Opreator test result.
362
363 if (.not. allocated(lhs%chars)) then
364 res = allocated(rhs%chars)
365 else
366 res = lhs%chars == rhs%chars
367 end if
368 end function
369
370 !> Equality comparison between string and character expression.
371 !! @param[in] lhs string
372 !! @param[in] rhs character expression
373 !! @return .true. if equal, .false. otherwise.
374 !!
375 !! @b Remarks
376 elemental function string_eq_character(lhs, rhs) result(res)
377 class(string), intent(in) :: lhs !! Left hand side.
378 character(*), intent(in) :: rhs !! Right hand side.
379 logical :: res !! Opreator test result.
380
381 if (.not. allocated(lhs%chars)) then
382 res = .false.
383 else
384 res = lhs%chars == rhs
385 end if
386 end function
387
388 !> Equality comparison (reversed) between character expression and string.
389 !! @param[in] lhs character expression
390 !! @param[in] rhs string
391 !! @return .true. if equal, .false. otherwise.
392 !!
393 !! @b Remarks
394 elemental function character_eq_string(lhs, rhs) result(res)
395 character(*), intent(in) :: lhs !! Left hand side.
396 class(string), intent(in) :: rhs !! Right hand side.
397 logical :: res !! Operator test result.
398
399 if (.not. allocated(rhs%chars)) then
400 res = .false.
401 else
402 res = rhs%chars == lhs
403 end if
404 end function
405
406 !> Formatted output procedure for user-defined type @ref string (UDTIO)
407 !! This procedure is called automatically when a formatted WRITE statement is used
408 !! with a variable of type `string` (when using the DT edit descriptor or default
409 !! formatted output for the type).
410 !!
411 !! It writes the content of the string component `dtv%chars` using a simple `A` format.
412 !! If the string is not allocated, an empty string is written.
413 !!
414 !! @param[in] dtv The @ref string object to be written (polymorphic dummy argument)
415 !! @param[in] unit Fortran logical unit number
416 !! @param[in] iotype String describing the edit descriptor ('DT' + optional string)
417 !! @param[in] v_list Integer array containing the values from the DT edit descriptor
418 !! (v_list is empty if no parentheses were used after DT)
419 !! @param[out] iostat I/O status code (0 = success, positive = error, negative = end-of-file/end-of-record)
420 !! @param[inout] iomsg Message describing the I/O error (if any)
421 !!
422 !! @b Note
423 !! - This implementation **ignores** `iotype` and `v_list` parameters
424 !! → the same simple character output is always performed
425 !! - The procedure always uses format `(A)`
426 !! - Empty (not allocated) string is written as empty line (zero characters)
427 !!
428 !! @b Warning
429 !! This is a minimal implementation of UDTIO formatted output.
430 !! More sophisticated versions could:
431 !! - respect `iotype` (DT"..." or LISTDIRECTED)
432 !! - use `v_list` for width/precision control
433 !! - add quotation marks, escaping, etc.
434 !!
435 !! @b Examples
436 !! @code{.f90}
437 !! type(string) :: s
438 !! call s%set("Hello formatted world!")
439 !!
440 !! write(*, *) s ! may call write_formatted (depending on compiler)
441 !! write(*, '(DT)') s ! explicitly calls write_formatted
442 !! @endcode
443 !!
444 !! @b Remarks
445 ! allow(assumed-size-character-intent)
446 subroutine write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
447 class(string), intent(in) :: dtv
448 integer, intent(in) :: unit !! Logical unit.
449 character(*), intent(in) :: iotype !! Edit descriptor.
450 integer, intent(in) :: v_list(:) !! Edit descriptor list.
451 integer, intent(out) :: iostat !! IO status code.
452 character(*), intent(inout) :: iomsg !! IO status message.
453
454 if (allocated(dtv%chars)) then
455 write(unit, '(A)', iostat=iostat, iomsg=iomsg) dtv%chars
456 else
457 write(unit, '(A)', iostat=iostat, iomsg=iomsg) ''
458 end if
459 end subroutine
460
461 !> Checks if a string starts with a given prefix
462 !! Returns `.true.` if the string `str` (after trimming leading/trailing whitespace)
463 !! begins exactly with the substring `arg1`.
464 !! The function uses `index()` after trimming both strings with `trim(adjustl())`.
465 !!
466 !! @param[in] str The string to be tested
467 !! @param[in] arg1 The prefix to look for at the beginning of `str`
468 !! @param[out] idx (optional) If present, receives the starting position of `arg1` in the trimmed string
469 !! (will be 1 if the function returns `.true.`, otherwise >1 or 0)
470 !!
471 !! @return `.true.` if `str` starts with `arg1` (after trimming), `.false.` otherwise
472 !!
473 !! @b Note
474 !! - Leading and trailing whitespace of both `str` and `arg1` is ignored
475 !! - Comparison is case-sensitive
476 !! - Empty `arg1` will always return `.true.` (any string starts with empty string)
477 !!
478 !! @b Warning
479 !! The returned index (when requested) is the position **after trimming** of the input string,
480 !! not in the original untrimmed string.
481 !!
482 !! @b Examples
483 !! @code{.f90}
484 !! character(80) :: line = ' hello world '
485 !! logical :: ok
486 !! integer :: pos
487 !!
488 !! ok = starts_with(line, 'hello') ! → .true.
489 !! ok = starts_with(line, 'hello', pos) ! → .true. and pos = 1
490 !! ok = starts_with(line, 'world') ! → .false.
491 !! ok = starts_with(' test123 ', 'test') ! → .true.
492 !! ...
493 !! @endcode
494 !!
495 !! @b Remarks
496 !! @ingroup group_string
497 logical function starts_with(str, arg1, idx) result(res)
498 character(*), intent(in) :: str
499 character(*), intent(in) :: arg1
500 integer, intent(out), optional :: idx
501 !private
502 integer :: i
503
504 i = index(trim(adjustl(str)), trim(arg1))
505 res = (i == 1)
506 if (present(idx)) idx = i
507 end function
508
509 !> Returns the first non-blank character of a string.
510 !! @param[in] str input string
511 !! @return First character (space if empty)
512 !!
513 !! @b Remarks
514 !! @ingroup group_string
515 character function head(str) result(res)
516 character(*), intent(in) :: str
517
518 res = ' '
519 if (len_trim(str) == 0) return
520
521 res = str(1:1)
522 end function
523
524 !> Returns the last non-blank character of a string.
525 !! @param[in] str input string
526 !! @return Last character (space if empty)
527 !!
528 !! @b Remarks
529 !! @ingroup group_string
530 character function tail(str) result(res)
531 character(*), intent(in) :: str
532 !private
533 integer :: n
534
535 res = ' '; n = len_trim(str)
536 if (n == 0) return
537
538 res = str(n:n)
539 end function
540
541 !> Smart concatenation that removes continuation markers (&) and handles line-continuation rules.
542 !! @param[in] str1 first line
543 !! @param[in] str2 second line
544 !! @return Concatenated string with proper continuation handling
545 !!
546 !! @b Remarks
547 !! @ingroup group_string
548 function concat(str1, str2) result(res)
549 character(*), intent(in) :: str1
550 character(*), intent(in) :: str2
551 character(:), allocatable :: res
552 !private
553 integer :: n1, n2
554
555 n1 = len(str1); n2 = 1
556 if (head(str1) == '!') then
557 n2 = 2
558 if (tail(str1) == '&') n1 = len_trim(str1) - 1
559 if (starts_with(str2, '!dir$') .or. starts_with(str2, '!DIR$') .or. &
560 starts_with(str2, '!dec$') .or. starts_with(str2, '!DEC$') .or. &
561 starts_with(str2, '!gcc$') .or. starts_with(str2, '!GCC$') .or. &
562 starts_with(str2, '!acc$') .or. starts_with(str2, '!ACC$') .or. &
563 starts_with(str2, '!$omp') .or. starts_with(str2, '!$OMP')) then
564 n2 = 6
565 end if
566 if (head(adjustl(str2(n2:))) == '&') then
567 n2 = index(str2, '&') + 1
568 end if
569 else
570 if (tail(str1) == '&') n1 = len_trim(str1) - 1
571 if (head(trim(str2)) == '&') n2 = index(str2, '&') + 1
572 if (tail(str1(:n1)) == '(') n1 = index(str1(:n1), '(', back=.true.)
573 end if
574
575 if (len(str1) > 0 .and. len(str2) >= n2) then
576 if (str1(n1:n1) == ' ' .and. str2(n2:n2) == ' ') n2 = n2 + 1
577 end if
578 res = str1(:n1) // str2(n2:)
579 end function
580
581 !> Convert string to upper case (respects contents of quotes).
582 !! @param[in] str input string
583 !! @return Upper-case version of the string
584 !!
585 !! @b Examples
586 !! @code
587 !! character(*), parameter :: input = 'test'
588 !! character(:), allocatable :: output
589 !! output = uppercase(input)
590 !! if (output == 'TEST') print*, 'OK'
591 !! @endcode
592 !!
593 !! @b Remarks
594 !! @ingroup group_string
595 pure function uppercase(str) result(res)
596 character(*), intent(in) :: str
597 character(len_trim(str)) :: res
598 !private
599 integer :: ilen, ioffset, iquote, iqc, iav, i
600
601 ilen = len_trim(str)
602 ioffset = iachar('A') - iachar('a')
603 iquote = 0
604 res = str
605 do i = 1, ilen
606 iav = iachar(str(i:i))
607 if (iquote == 0 .and. (iav == 34 .or. iav == 39)) then
608 iquote = 1
609 iqc = iav
610 cycle
611 end if
612 if (iquote == 1 .and. iav == iqc) then
613 iquote = 0
614 cycle
615 end if
616 if (iquote == 1) cycle
617 if (iav >= iachar('a') .and. iav <= iachar('z')) then
618 res(i:i) = achar(iav + ioffset)
619 else
620 res(i:i) = str(i:i)
621 end if
622 end do
623 end function
624
625 !> Convert string to lower case (respects contents of quotes).
626 !! @param[in] str input string
627 !! @return Lower-case version of the string
628 !!
629 !! @b Examples
630 !! @code
631 !! character(*), parameter :: input = 'TEST'
632 !! character(:), allocatable :: output
633 !! output = lowercase(input)
634 !! if (output == 'test') print*, 'OK'
635 !! @endcode
636 !!
637 !! @b Remarks
638 !! @ingroup group_string
639 pure function lowercase(str) result(res)
640 character(*), intent(in) :: str
641 character(len_trim(str)) :: res
642 !private
643 integer :: ilen, ioffset, iquote, iqc, iav, i
644
645 ilen = len_trim(str)
646 ioffset = iachar('A') - iachar('a')
647 iquote = 0
648 res = str
649 do i = 1, ilen
650 iav = iachar(str(i:i))
651 if (iquote == 0 .and. (iav == 34 .or. iav == 39)) then
652 iquote = 1
653 iqc = iav
654 cycle
655 end if
656 if (iquote == 1 .and. iav == iqc) then
657 iquote = 0
658 cycle
659 end if
660 if (iquote == 1) cycle
661 if (iav >= iachar('A') .and. iav <= iachar('Z')) then
662 res(i:i) = achar(iav - ioffset)
663 else
664 res(i:i) = str(i:i)
665 end if
666 end do
667 end function
668
669 !> Write a long line split into chunks of size CHKSIZE with continuation (&).
670 !! @param[in] unit logical unit
671 !! @param[in] str string to write
672 !!
673 !! @b Remarks
674 !! @ingroup group_string
675 subroutine writechk(unit, str)
676 integer, intent(in) :: unit
677 character(*), intent(in) :: str
678 !private
679 integer :: i, n
680
681 n = 0
682 if (head(str) /= '!') then
683 n = floor(len(str) / real(chksize))
684 do i = 1, n
685 write(unit, '(A)') str((i - 1) * chksize + 1:i * chksize) // '&'
686 end do
687 end if
688 write(unit, '(A)') str(n * chksize + 1:)
689 end subroutine
690
691 !> Returns the previous non-blank character before position pos (updates pos).
692 !! @param[in] line input line
693 !! @param[inout] pos current position (moved backward)
694 !! @return Previous non-blank character
695 !!
696 !! @b Remarks
697 !! @ingroup group_string
698 character(1) function previous(line, pos) result(res)
699 character(*), intent(in) :: line
700 integer, intent(inout) :: pos
701 !private
702
703 if (pos == 1) then
704 res = trim(line(pos:pos))
705 else
706 do while (line(pos:pos) == ' ')
707 pos = pos - 1
708 if (pos == 1) exit
709 end do
710 res = line(pos:pos)
711 end if
712 end function
713
714 !> Checks whether an array of string contains a given string.
715 !! @param[in] lhs array of string
716 !! @param[in] rhs string to search for
717 !! @return .true. if rhs is present in lhs
718 !!
719 !! @b Remarks
720 logical function strings_contain_string(lhs, rhs) result(res)
721 type(string), intent(in) :: lhs(:)
722 type(string), intent(in) :: rhs
723 !private
724 integer :: i
725
726 res = .false.
727 do i = 1, size(lhs)
728 if (lhs(i) == rhs) then
729 res = .true.
730 exit
731 end if
732 end do
733 end function
734
735 !> Checks whether an array of string contains a given character expression.
736 !! @param[in] lhs array of string
737 !! @param[in] rhs character expression to search for
738 !! @return .true. if rhs is present in lhs
739 !!
740 !! @b Remarks
741 logical function strings_contain_character(lhs, rhs) result(res)
742 type(string), intent(in) :: lhs(:)
743 character(*), intent(in) :: rhs
744 !private
745 integer :: i
746
747 res = .false.
748 do i = 1, size(lhs)
749 if (lhs(i) == rhs) then
750 res = .true.
751 exit
752 end if
753 end do
754 end function
755
756 !> Checks whether an array of character contains a given character expression.
757 !! @param[in] lhs array of character
758 !! @param[in] rhs character expression to search for
759 !! @return .true. if rhs is present in lhs
760 !!
761 !! @b Remarks
762 logical function characters_contain_character(lhs, rhs) result(res)
763 character(*), intent(in) :: lhs(:)
764 character(*), intent(in) :: rhs
765 !private
766 integer :: i
767
768 res = .false.
769 do i = 1, size(lhs)
770 if (lhs(i) == rhs) then
771 res = .true.
772 exit
773 end if
774 end do
775 end function
776
777 !> Checks whether an array of character contains a given string.
778 !! @param[in] lhs array of character
779 !! @param[in] rhs string to search for
780 !! @return .true. if rhs is present in lhs
781 !!
782 !! @b Remarks
783 logical function characters_contain_string(lhs, rhs) result(res)
784 character(*), intent(in) :: lhs(:)
785 type(string), intent(in) :: rhs
786 !private
787 integer :: i
788
789 res = .false.
790 do i = 1, size(lhs)
791 if (lhs(i) == rhs) then
792 res = .true.
793 exit
794 end if
795 end do
796 end function
797
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
802
803 res = index(str%chars, substr%chars, back=back)
804 end function
805
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
810
811 res = index(str, substr%chars, back=back)
812 end function
813
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
818
819 res = index(str%chars, substr, back=back)
820 end function
821
822end module
integer, parameter, public chksize
Maximum chunk size.
Definition constants.f90:31
character function, public tail(str)
Returns the last non-blank character of a string.
Definition string.f90:531
pure character(len_trim(str)) function, public lowercase(str)
Convert string to lower case (respects contents of quotes).
Definition string.f90:640
subroutine, public writechk(unit, str)
Write a long line split into chunks of size CHKSIZE with continuation (&).
Definition string.f90:676
character(1) function, public previous(line, pos)
Returns the previous non-blank character before position pos (updates pos).
Definition string.f90:699
pure character(len_trim(str)) function, public uppercase(str)
Convert string to upper case (respects contents of quotes).
Definition string.f90:596
character(:) function, allocatable, public concat(str1, str2)
Smart concatenation that removes continuation markers (&) and handles line-continuation rules.
Definition string.f90:549
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...
Definition string.f90:498
character function, public head(str)
Returns the first non-blank character of a string.
Definition string.f90:516
Index operator.
Definition string.f90:178
Return the trimmed length of a string.
Definition string.f90:141
Return the length of a string.
Definition string.f90:133
Return the trimmed string.
Definition string.f90:149
Represents text as a sequence of ASCII code units. The derived type wraps an allocatable character ar...
Definition string.f90:110