54 module iso_varying_string
55 use,
INTRINSIC :: iso_c_binding
63 integer,
parameter,
private :: get_buffer_len = 256
67 type,
public :: varying_string
69 character(LEN=1),
dimension(:),
allocatable :: chars
70 end type varying_string
74 interface assignment(=)
75 module procedure op_assign_ch_vs
76 module procedure op_assign_vs_ch
77 end interface assignment(=)
79 interface operator(//)
80 module procedure op_concat_vs_vs
81 module procedure op_concat_ch_vs
82 module procedure op_concat_vs_ch
83 end interface operator(//)
85 interface operator(==)
86 module procedure op_eq_vs_vs
87 module procedure op_eq_ch_vs
88 module procedure op_eq_vs_ch
89 end interface operator(==)
91 interface operator(/=)
92 module procedure op_ne_vs_vs
93 module procedure op_ne_ch_vs
94 module procedure op_ne_vs_ch
95 end interface operator (/=)
98 module procedure op_lt_vs_vs
99 module procedure op_lt_ch_vs
100 module procedure op_lt_vs_ch
101 end interface operator (<)
103 interface operator(<=)
104 module procedure op_le_vs_vs
105 module procedure op_le_ch_vs
106 module procedure op_le_vs_ch
107 end interface operator (<=)
109 interface operator(>=)
110 module procedure op_ge_vs_vs
111 module procedure op_ge_ch_vs
112 module procedure op_ge_vs_ch
113 end interface operator (>=)
115 interface operator(>)
116 module procedure op_gt_vs_vs
117 module procedure op_gt_ch_vs
118 module procedure op_gt_vs_ch
119 end interface operator (>)
122 module procedure adjustl_
123 end interface adjustl
126 module procedure adjustr_
127 end interface adjustr
130 module procedure char_auto
131 module procedure char_fixed
135 module procedure iachar_
139 module procedure ichar_
143 module procedure index_vs_vs
144 module procedure index_ch_vs
145 module procedure index_vs_ch
149 module procedure len_
153 module procedure len_trim_
154 end interface len_trim
157 module procedure lge_vs_vs
158 module procedure lge_ch_vs
159 module procedure lge_vs_ch
163 module procedure lgt_vs_vs
164 module procedure lgt_ch_vs
165 module procedure lgt_vs_ch
169 module procedure lle_vs_vs
170 module procedure lle_ch_vs
171 module procedure lle_vs_ch
175 module procedure llt_vs_vs
176 module procedure llt_ch_vs
177 module procedure llt_vs_ch
181 module procedure repeat_
185 module procedure scan_vs_vs
186 module procedure scan_ch_vs
187 module procedure scan_vs_ch
191 module procedure trim_
195 module procedure verify_vs_vs
196 module procedure verify_ch_vs
197 module procedure verify_vs_ch
201 module procedure var_str_
202 module procedure var_str_c_ptr
203 end interface var_str
206 module procedure get_
207 module procedure get_unit
208 module procedure get_set_vs
209 module procedure get_set_ch
210 module procedure get_unit_set_vs
211 module procedure get_unit_set_ch
215 module procedure put_vs
216 module procedure put_ch
217 module procedure put_unit_vs
218 module procedure put_unit_ch
222 module procedure put_line_vs
223 module procedure put_line_ch
224 module procedure put_line_unit_vs
225 module procedure put_line_unit_ch
226 end interface put_line
229 module procedure extract_vs
230 module procedure extract_ch
231 end interface extract
234 module procedure insert_vs_vs
235 module procedure insert_ch_vs
236 module procedure insert_vs_ch
237 module procedure insert_ch_ch
241 module procedure remove_vs
242 module procedure remove_ch
246 module procedure replace_vs_vs_auto
247 module procedure replace_ch_vs_auto
248 module procedure replace_vs_ch_auto
249 module procedure replace_ch_ch_auto
250 module procedure replace_vs_vs_fixed
251 module procedure replace_ch_vs_fixed
252 module procedure replace_vs_ch_fixed
253 module procedure replace_ch_ch_fixed
254 module procedure replace_vs_vs_vs_target
255 module procedure replace_ch_vs_vs_target
256 module procedure replace_vs_ch_vs_target
257 module procedure replace_ch_ch_vs_target
258 module procedure replace_vs_vs_ch_target
259 module procedure replace_ch_vs_ch_target
260 module procedure replace_vs_ch_ch_target
261 module procedure replace_ch_ch_ch_target
265 module procedure split_vs
266 module procedure split_ch
270 module procedure c_ptr_new_vs
271 end interface c_ptr_new
276 public :: assignment(=)
277 public :: operator(//)
278 public :: operator(==)
279 public :: operator(/=)
280 public :: operator(<)
281 public :: operator(<=)
282 public :: operator(>=)
283 public :: operator(>)
310 private :: op_assign_ch_vs
311 private :: op_assign_vs_ch
312 private :: op_concat_vs_vs
313 private :: op_concat_ch_vs
314 private :: op_concat_vs_ch
315 private :: op_eq_vs_vs
316 private :: op_eq_ch_vs
317 private :: op_eq_vs_ch
318 private :: op_ne_vs_vs
319 private :: op_ne_ch_vs
320 private :: op_ne_vs_ch
321 private :: op_lt_vs_vs
322 private :: op_lt_ch_vs
323 private :: op_lt_vs_ch
324 private :: op_le_vs_vs
325 private :: op_le_ch_vs
326 private :: op_le_vs_ch
327 private :: op_ge_vs_vs
328 private :: op_ge_ch_vs
329 private :: op_ge_vs_ch
330 private :: op_gt_vs_vs
331 private :: op_gt_ch_vs
332 private :: op_gt_vs_ch
336 private :: char_fixed
339 private :: index_vs_vs
340 private :: index_ch_vs
341 private :: index_vs_ch
357 private :: scan_vs_vs
358 private :: scan_ch_vs
359 private :: scan_vs_ch
361 private :: verify_vs_vs
362 private :: verify_ch_vs
363 private :: verify_vs_ch
365 private :: var_str_c_ptr
368 private :: get_set_vs
369 private :: get_set_ch
370 private :: get_unit_set_vs
371 private :: get_unit_set_ch
374 private :: put_unit_vs
375 private :: put_unit_ch
376 private :: put_line_vs
377 private :: put_line_ch
378 private :: put_line_unit_vs
379 private :: put_line_unit_ch
380 private :: extract_vs
381 private :: extract_ch
382 private :: insert_vs_vs
383 private :: insert_ch_vs
384 private :: insert_vs_ch
385 private :: insert_ch_ch
388 private :: replace_vs_vs_auto
389 private :: replace_ch_vs_auto
390 private :: replace_vs_ch_auto
391 private :: replace_ch_ch_auto
392 private :: replace_vs_vs_fixed
393 private :: replace_ch_vs_fixed
394 private :: replace_vs_ch_fixed
395 private :: replace_ch_ch_fixed
396 private :: replace_vs_vs_vs_target
397 private :: replace_ch_vs_vs_target
398 private :: replace_vs_ch_vs_target
399 private :: replace_ch_ch_vs_target
400 private :: replace_vs_vs_ch_target
401 private :: replace_ch_vs_ch_target
402 private :: replace_vs_ch_ch_target
403 private :: replace_ch_ch_ch_target
413 elemental subroutine op_assign_ch_vs (var, exp)
415 character(LEN=*),
intent(out) :: var
416 type(varying_string),
intent(in) :: exp
426 end subroutine op_assign_ch_vs
430 elemental subroutine op_assign_vs_ch (var, exp)
432 type(varying_string),
intent(out) :: var
433 character(LEN=*),
intent(in) :: exp
443 end subroutine op_assign_vs_ch
447 elemental function op_concat_vs_vs (string_a, string_b) result (concat_string)
449 type(varying_string),
intent(in) :: string_a
450 type(varying_string),
intent(in) :: string_b
451 type(varying_string) :: concat_string
453 integer :: len_string_a
457 len_string_a = len(string_a)
459 ALLOCATE(concat_string%chars(len_string_a+len(string_b)+1))
460 concat_string%chars(:len_string_a) = string_a%chars(:len_string_a)
461 concat_string%chars(len_string_a+1:) = string_b%chars(:)
468 end function op_concat_vs_vs
472 elemental function op_concat_ch_vs (string_a, string_b) result (concat_string)
474 character(LEN=*),
intent(in) :: string_a
475 type(varying_string),
intent(in) :: string_b
476 type(varying_string) :: concat_string
481 concat_string = op_concat_vs_vs(var_str(string_a), string_b)
487 end function op_concat_ch_vs
491 elemental function op_concat_vs_ch (string_a, string_b) result (concat_string)
493 type(varying_string),
intent(in) :: string_a
494 character(LEN=*),
intent(in) :: string_b
495 type(varying_string) :: concat_string
500 concat_string = op_concat_vs_vs(string_a, var_str(string_b))
506 end function op_concat_vs_ch
510 elemental function op_eq_vs_vs (string_a, string_b) result (op_eq)
512 type(varying_string),
intent(in) :: string_a
513 type(varying_string),
intent(in) :: string_b
518 op_eq = char(string_a) == char(string_b)
524 end function op_eq_vs_vs
528 elemental function op_eq_ch_vs (string_a, string_b) result (op_eq)
530 character(LEN=*),
intent(in) :: string_a
531 type(varying_string),
intent(in) :: string_b
537 op_eq = string_a == char(string_b)
543 end function op_eq_ch_vs
547 elemental function op_eq_vs_ch (string_a, string_b) result (op_eq)
549 type(varying_string),
intent(in) :: string_a
550 character(LEN=*),
intent(in) :: string_b
556 op_eq = char(string_a) == string_b
562 end function op_eq_vs_ch
566 elemental function op_ne_vs_vs (string_a, string_b) result (op_ne)
568 type(varying_string),
intent(in) :: string_a
569 type(varying_string),
intent(in) :: string_b
574 op_ne = char(string_a) /= char(string_b)
580 end function op_ne_vs_vs
584 elemental function op_ne_ch_vs (string_a, string_b) result (op_ne)
586 character(LEN=*),
intent(in) :: string_a
587 type(varying_string),
intent(in) :: string_b
593 op_ne = string_a /= char(string_b)
599 end function op_ne_ch_vs
603 elemental function op_ne_vs_ch (string_a, string_b) result (op_ne)
605 type(varying_string),
intent(in) :: string_a
606 character(LEN=*),
intent(in) :: string_b
612 op_ne = char(string_a) /= string_b
618 end function op_ne_vs_ch
622 elemental function op_lt_vs_vs (string_a, string_b) result (op_lt)
624 type(varying_string),
intent(in) :: string_a
625 type(varying_string),
intent(in) :: string_b
630 op_lt = char(string_a) < char(string_b)
636 end function op_lt_vs_vs
640 elemental function op_lt_ch_vs (string_a, string_b) result (op_lt)
642 character(LEN=*),
intent(in) :: string_a
643 type(varying_string),
intent(in) :: string_b
649 op_lt = string_a < char(string_b)
655 end function op_lt_ch_vs
659 elemental function op_lt_vs_ch (string_a, string_b) result (op_lt)
661 type(varying_string),
intent(in) :: string_a
662 character(LEN=*),
intent(in) :: string_b
668 op_lt = char(string_a) < string_b
674 end function op_lt_vs_ch
678 elemental function op_le_vs_vs (string_a, string_b) result (op_le)
680 type(varying_string),
intent(in) :: string_a
681 type(varying_string),
intent(in) :: string_b
686 op_le = char(string_a) <= char(string_b)
692 end function op_le_vs_vs
696 elemental function op_le_ch_vs (string_a, string_b) result (op_le)
698 character(LEN=*),
intent(in) :: string_a
699 type(varying_string),
intent(in) :: string_b
705 op_le = string_a <= char(string_b)
711 end function op_le_ch_vs
715 elemental function op_le_vs_ch (string_a, string_b) result (op_le)
717 type(varying_string),
intent(in) :: string_a
718 character(LEN=*),
intent(in) :: string_b
724 op_le = char(string_a) <= string_b
730 end function op_le_vs_ch
734 elemental function op_ge_vs_vs (string_a, string_b) result (op_ge)
736 type(varying_string),
intent(in) :: string_a
737 type(varying_string),
intent(in) :: string_b
742 op_ge = char(string_a) >= char(string_b)
748 end function op_ge_vs_vs
752 elemental function op_ge_ch_vs (string_a, string_b) result (op_ge)
754 character(LEN=*),
intent(in) :: string_a
755 type(varying_string),
intent(in) :: string_b
761 op_ge = string_a >= char(string_b)
767 end function op_ge_ch_vs
771 elemental function op_ge_vs_ch (string_a, string_b) result (op_ge)
773 type(varying_string),
intent(in) :: string_a
774 character(LEN=*),
intent(in) :: string_b
780 op_ge = char(string_a) >= string_b
786 end function op_ge_vs_ch
790 elemental function op_gt_vs_vs (string_a, string_b) result (op_gt)
792 type(varying_string),
intent(in) :: string_a
793 type(varying_string),
intent(in) :: string_b
798 op_gt = char(string_a) > char(string_b)
804 end function op_gt_vs_vs
808 elemental function op_gt_ch_vs (string_a, string_b) result (op_gt)
810 character(LEN=*),
intent(in) :: string_a
811 type(varying_string),
intent(in) :: string_b
817 op_gt = string_a > char(string_b)
823 end function op_gt_ch_vs
827 elemental function op_gt_vs_ch (string_a, string_b) result (op_gt)
829 type(varying_string),
intent(in) :: string_a
830 character(LEN=*),
intent(in) :: string_b
836 op_gt = char(string_a) > string_b
842 end function op_gt_vs_ch
846 elemental function adjustl_ (string) result (adjustl_string)
848 type(varying_string),
intent(in) :: string
849 type(varying_string) :: adjustl_string
853 adjustl_string = adjustl(char(string))
859 end function adjustl_
863 elemental function adjustr_ (string) result (adjustr_string)
865 type(varying_string),
intent(in) :: string
866 type(varying_string) :: adjustr_string
870 adjustr_string = adjustr(char(string))
876 end function adjustr_
880 pure function char_auto (string) result (char_string)
882 type(varying_string),
intent(in) :: string
883 character(LEN=len(string)) :: char_string
890 forall(i_char = 1:len(string))
891 char_string(i_char:i_char) = string%chars(i_char)
898 end function char_auto
902 pure function char_fixed (string, length) result (char_string)
904 type(varying_string),
intent(in) :: string
905 integer,
intent(in) :: length
906 character(LEN=length) :: char_string
911 char_string = char(string)
917 end function char_fixed
921 elemental function iachar_ (c) result (i)
923 type(varying_string),
intent(in) :: c
939 elemental function ichar_ (c) result (i)
941 type(varying_string),
intent(in) :: c
957 elemental function index_vs_vs (string, substring, back) result (i_substring)
959 type(varying_string),
intent(in) :: string
960 type(varying_string),
intent(in) :: substring
961 logical,
intent(in),
optional :: back
962 integer :: i_substring
967 i_substring = index(char(string), char(substring), back)
973 end function index_vs_vs
977 elemental function index_ch_vs (string, substring, back) result (i_substring)
979 character(LEN=*),
intent(in) :: string
980 type(varying_string),
intent(in) :: substring
981 logical,
intent(in),
optional :: back
982 integer :: i_substring
987 i_substring = index(string, char(substring), back)
993 end function index_ch_vs
997 elemental function index_vs_ch (string, substring, back) result (i_substring)
999 type(varying_string),
intent(in) :: string
1000 character(LEN=*),
intent(in) :: substring
1001 logical,
intent(in),
optional :: back
1002 integer :: i_substring
1007 i_substring = index(char(string), substring, back)
1013 end function index_vs_ch
1017 elemental function len_ (string) result (length)
1019 type(varying_string),
intent(in) :: string
1024 if(
ALLOCATED(string%chars))
then 1025 length =
SIZE(string%chars)-1
1038 elemental function len_trim_ (string) result (length)
1040 type(varying_string),
intent(in) :: string
1045 if(
ALLOCATED(string%chars))
then 1046 length = len_trim(char(string))
1055 end function len_trim_
1059 elemental function lge_vs_vs (string_a, string_b) result (comp)
1061 type(varying_string),
intent(in) :: string_a
1062 type(varying_string),
intent(in) :: string_b
1067 comp = (char(string_a) >= char(string_b))
1073 end function lge_vs_vs
1077 elemental function lge_ch_vs (string_a, string_b) result (comp)
1079 character(LEN=*),
intent(in) :: string_a
1080 type(varying_string),
intent(in) :: string_b
1086 comp = (string_a >= char(string_b))
1092 end function lge_ch_vs
1096 elemental function lge_vs_ch (string_a, string_b) result (comp)
1098 type(varying_string),
intent(in) :: string_a
1099 character(LEN=*),
intent(in) :: string_b
1105 comp = (char(string_a) >= string_b)
1111 end function lge_vs_ch
1115 elemental function lgt_vs_vs (string_a, string_b) result (comp)
1117 type(varying_string),
intent(in) :: string_a
1118 type(varying_string),
intent(in) :: string_b
1123 comp = (char(string_a) > char(string_b))
1129 end function lgt_vs_vs
1133 elemental function lgt_ch_vs (string_a, string_b) result (comp)
1135 character(LEN=*),
intent(in) :: string_a
1136 type(varying_string),
intent(in) :: string_b
1142 comp = (string_a > char(string_b))
1148 end function lgt_ch_vs
1152 elemental function lgt_vs_ch (string_a, string_b) result (comp)
1154 type(varying_string),
intent(in) :: string_a
1155 character(LEN=*),
intent(in) :: string_b
1161 comp = (char(string_a) > string_b)
1167 end function lgt_vs_ch
1171 elemental function lle_vs_vs (string_a, string_b) result (comp)
1173 type(varying_string),
intent(in) :: string_a
1174 type(varying_string),
intent(in) :: string_b
1179 comp = (char(string_a) <= char(string_b))
1185 end function lle_vs_vs
1189 elemental function lle_ch_vs (string_a, string_b) result (comp)
1191 character(LEN=*),
intent(in) :: string_a
1192 type(varying_string),
intent(in) :: string_b
1198 comp = (string_a <= char(string_b))
1204 end function lle_ch_vs
1208 elemental function lle_vs_ch (string_a, string_b) result (comp)
1210 type(varying_string),
intent(in) :: string_a
1211 character(LEN=*),
intent(in) :: string_b
1217 comp = (char(string_a) <= string_b)
1223 end function lle_vs_ch
1227 elemental function llt_vs_vs (string_a, string_b) result (comp)
1229 type(varying_string),
intent(in) :: string_a
1230 type(varying_string),
intent(in) :: string_b
1235 comp = (char(string_a) < char(string_b))
1241 end function llt_vs_vs
1245 elemental function llt_ch_vs (string_a, string_b) result (comp)
1247 character(LEN=*),
intent(in) :: string_a
1248 type(varying_string),
intent(in) :: string_b
1254 comp = (string_a < char(string_b))
1260 end function llt_ch_vs
1264 elemental function llt_vs_ch (string_a, string_b) result (comp)
1266 type(varying_string),
intent(in) :: string_a
1267 character(LEN=*),
intent(in) :: string_b
1273 comp = (char(string_a) < string_b)
1279 end function llt_vs_ch
1283 elemental function repeat_ (string, ncopies) result (repeat_string)
1285 type(varying_string),
intent(in) :: string
1286 integer,
intent(in) :: ncopies
1287 type(varying_string) :: repeat_string
1291 repeat_string = var_str(repeat(char(string), ncopies))
1297 end function repeat_
1301 elemental function scan_vs_vs (string, set, back) result (i)
1303 type(varying_string),
intent(in) :: string
1304 type(varying_string),
intent(in) :: set
1305 logical,
intent(in),
optional :: back
1311 i = scan(char(string), char(set), back)
1317 end function scan_vs_vs
1321 elemental function scan_ch_vs (string, set, back) result (i)
1323 character(LEN=*),
intent(in) :: string
1324 type(varying_string),
intent(in) :: set
1325 logical,
intent(in),
optional :: back
1331 i = scan(string, char(set), back)
1337 end function scan_ch_vs
1341 elemental function scan_vs_ch (string, set, back) result (i)
1343 type(varying_string),
intent(in) :: string
1344 character(LEN=*),
intent(in) :: set
1345 logical,
intent(in),
optional :: back
1351 i = scan(char(string), set, back)
1357 end function scan_vs_ch
1361 elemental function trim_ (string) result (trim_string)
1363 type(varying_string),
intent(in) :: string
1364 type(varying_string) :: trim_string
1368 trim_string = trim(char(string))
1378 elemental function verify_vs_vs (string, set, back) result (i)
1380 type(varying_string),
intent(in) :: string
1381 type(varying_string),
intent(in) :: set
1382 logical,
intent(in),
optional :: back
1388 i = verify(char(string), char(set), back)
1394 end function verify_vs_vs
1398 elemental function verify_ch_vs (string, set, back) result (i)
1400 character(LEN=*),
intent(in) :: string
1401 type(varying_string),
intent(in) :: set
1402 logical,
intent(in),
optional :: back
1408 i = verify(string, char(set), back)
1414 end function verify_ch_vs
1418 elemental function verify_vs_ch (string, set, back) result (i)
1420 type(varying_string),
intent(in) :: string
1421 character(LEN=*),
intent(in) :: set
1422 logical,
intent(in),
optional :: back
1428 i = verify(char(string), set, back)
1434 end function verify_vs_ch
1438 elemental function var_str_ (char_) result (string)
1440 character(LEN=*),
intent(in) :: char_
1441 type(varying_string) :: string
1450 ALLOCATE(string%chars(length+1))
1452 forall(i_char = 1:length)
1453 string%chars(i_char) = char_(i_char:i_char)
1455 string%chars(length+1) = char(0)
1461 end function var_str_
1465 function var_str_c_ptr (char_c_ptr) result (string)
1467 type(c_ptr),
intent(in) :: char_c_ptr
1468 type(varying_string) :: string
1470 CHARACTER(len=1),
pointer :: char_(:)
1475 IF (c_associated(char_c_ptr))
THEN 1477 CALL c_f_pointer(char_c_ptr, char_, (/huge(1)-1/))
1479 DO length = 1,
SIZE(char_)
1480 IF (char_(length) == char(0))
EXIT 1483 ALLOCATE(string%chars(length))
1484 string%chars(:) = char_(1:length)
1485 string%chars(length) = char(0)
1489 string = var_str(
'')
1497 end function var_str_c_ptr
1501 subroutine get_ (string, maxlen, iostat)
1503 type(varying_string),
intent(out) :: string
1504 integer,
intent(in),
optional :: maxlen
1505 integer,
intent(out),
optional :: iostat
1507 integer :: n_chars_remain
1508 integer :: n_chars_read
1509 character(LEN=GET_BUFFER_LEN) :: buffer
1510 integer :: local_iostat
1516 if(
PRESENT(maxlen))
then 1517 n_chars_remain = maxlen
1519 n_chars_remain = huge(1)
1524 if(n_chars_remain <= 0)
return 1526 n_chars_read = min(n_chars_remain, get_buffer_len)
1528 if(
PRESENT(iostat))
then 1529 read(unit=*, fmt=
"(A)", advance=
"NO", &
1530 iostat=iostat, size=n_chars_read) buffer(:n_chars_read)
1531 if(iostat < 0)
exit read_loop
1532 if(iostat > 0)
return 1534 read(unit=*, fmt=
"(A)", advance=
"NO", &
1535 iostat=local_iostat, size=n_chars_read) buffer(:n_chars_read)
1536 if(local_iostat < 0)
exit read_loop
1539 string = string//buffer(:n_chars_read)
1540 n_chars_remain = n_chars_remain - n_chars_read
1544 string = string//buffer(:n_chars_read)
1554 subroutine get_unit (unit, string, maxlen, iostat)
1556 integer,
intent(in) :: unit
1557 type(varying_string),
intent(out) :: string
1558 integer,
intent(in),
optional :: maxlen
1559 integer,
intent(out),
optional :: iostat
1561 integer :: n_chars_remain
1562 integer :: n_chars_read
1563 character(LEN=GET_BUFFER_LEN) :: buffer
1564 integer :: local_iostat
1570 if(
PRESENT(maxlen))
then 1571 n_chars_remain = maxlen
1573 n_chars_remain = huge(1)
1578 if(n_chars_remain <= 0)
return 1580 n_chars_read = min(n_chars_remain, get_buffer_len)
1582 if(
PRESENT(iostat))
then 1583 read(unit=unit, fmt=
"(A)", advance=
"NO", &
1584 iostat=iostat, size=n_chars_read) buffer(:n_chars_read)
1585 if(iostat < 0)
exit read_loop
1586 if(iostat > 0)
return 1588 read(unit=unit, fmt=
"(A)", advance=
"NO", &
1589 iostat=local_iostat, size=n_chars_read) buffer(:n_chars_read)
1590 if(local_iostat < 0)
exit read_loop
1593 string = string//buffer(:n_chars_read)
1594 n_chars_remain = n_chars_remain - n_chars_read
1598 string = string//buffer(:n_chars_read)
1604 end subroutine get_unit
1608 subroutine get_set_vs (string, set, separator, maxlen, iostat)
1610 type(varying_string),
intent(out) :: string
1611 type(varying_string),
intent(in) :: set
1612 type(varying_string),
intent(out),
optional :: separator
1613 integer,
intent(in),
optional :: maxlen
1614 integer,
intent(out),
optional :: iostat
1619 call get(string, char(set), separator, maxlen, iostat)
1625 end subroutine get_set_vs
1629 subroutine get_set_ch (string, set, separator, maxlen, iostat)
1631 type(varying_string),
intent(out) :: string
1632 character(LEN=*),
intent(in) :: set
1633 type(varying_string),
intent(out),
optional :: separator
1634 integer,
intent(in),
optional :: maxlen
1635 integer,
intent(out),
optional :: iostat
1637 integer :: n_chars_remain
1638 character(LEN=1) :: buffer
1640 integer :: local_iostat
1647 if(
PRESENT(maxlen))
then 1648 n_chars_remain = maxlen
1650 n_chars_remain = huge(1)
1653 if(
PRESENT(separator)) separator =
"" 1657 if(n_chars_remain <= 0)
return 1659 if(
PRESENT(iostat))
then 1660 read(unit=*, fmt=
"(A1)", advance=
"NO", iostat=iostat) buffer
1661 if(iostat /= 0)
exit read_loop
1663 read(unit=*, fmt=
"(A1)", advance=
"NO", iostat=local_iostat) buffer
1664 if(local_iostat /= 0)
exit read_loop
1667 i_set = scan(buffer, set)
1670 if(
PRESENT(separator)) separator = buffer
1674 string = string//buffer
1675 n_chars_remain = n_chars_remain - 1
1683 end subroutine get_set_ch
1687 subroutine get_unit_set_vs (unit, string, set, separator, maxlen, iostat)
1689 integer,
intent(in) :: unit
1690 type(varying_string),
intent(out) :: string
1691 type(varying_string),
intent(in) :: set
1692 type(varying_string),
intent(out),
optional :: separator
1693 integer,
intent(in),
optional :: maxlen
1694 integer,
intent(out),
optional :: iostat
1699 call get(unit, string, char(set), separator, maxlen, iostat)
1705 end subroutine get_unit_set_vs
1709 subroutine get_unit_set_ch (unit, string, set, separator, maxlen, iostat)
1711 integer,
intent(in) :: unit
1712 type(varying_string),
intent(out) :: string
1713 character(LEN=*),
intent(in) :: set
1714 type(varying_string),
intent(out),
optional :: separator
1715 integer,
intent(in),
optional :: maxlen
1716 integer,
intent(out),
optional :: iostat
1718 integer :: n_chars_remain
1719 character(LEN=1) :: buffer
1721 integer :: local_iostat
1728 if(
PRESENT(maxlen))
then 1729 n_chars_remain = maxlen
1731 n_chars_remain = huge(1)
1734 if(
PRESENT(separator)) separator =
"" 1738 if(n_chars_remain <= 0)
return 1740 if(
PRESENT(iostat))
then 1741 read(unit=unit, fmt=
"(A1)", advance=
"NO", iostat=iostat) buffer
1742 if(iostat /= 0)
exit read_loop
1744 read(unit=unit, fmt=
"(A1)", advance=
"NO", iostat=local_iostat) buffer
1745 if(local_iostat /= 0)
exit read_loop
1748 i_set = scan(buffer, set)
1751 if(
PRESENT(separator)) separator = buffer
1755 string = string//buffer
1756 n_chars_remain = n_chars_remain - 1
1764 end subroutine get_unit_set_ch
1768 subroutine put_vs (string, iostat)
1770 type(varying_string),
intent(in) :: string
1771 integer,
intent(out),
optional :: iostat
1776 call put(char(string), iostat)
1780 end subroutine put_vs
1784 subroutine put_ch (string, iostat)
1786 character(LEN=*),
intent(in) :: string
1787 integer,
intent(out),
optional :: iostat
1792 if(
PRESENT(iostat))
then 1793 write(unit=*, fmt=
"(A)", advance=
"NO", iostat=iostat) string
1795 write(unit=*, fmt=
"(A)", advance=
"NO") string
1800 end subroutine put_ch
1804 subroutine put_unit_vs (unit, string, iostat)
1806 integer,
intent(in) :: unit
1807 type(varying_string),
intent(in) :: string
1808 integer,
intent(out),
optional :: iostat
1813 call put(unit, char(string), iostat)
1819 end subroutine put_unit_vs
1823 subroutine put_unit_ch (unit, string, iostat)
1825 integer,
intent(in) :: unit
1826 character(LEN=*),
intent(in) :: string
1827 integer,
intent(out),
optional :: iostat
1832 if(
PRESENT(iostat))
then 1833 write(unit=unit, fmt=
"(A)", advance=
"NO", iostat=iostat) string
1835 write(unit=unit, fmt=
"(A)", advance=
"NO") string
1842 end subroutine put_unit_ch
1846 subroutine put_line_vs (string, iostat)
1848 type(varying_string),
intent(in) :: string
1849 integer,
intent(out),
optional :: iostat
1854 call put_line(char(string), iostat)
1860 end subroutine put_line_vs
1864 subroutine put_line_ch (string, iostat)
1866 character(LEN=*),
intent(in) :: string
1867 integer,
intent(out),
optional :: iostat
1872 if(
PRESENT(iostat))
then 1873 write(unit=*, fmt=
"(A,/)", advance=
"NO", iostat=iostat) string
1875 write(unit=*, fmt=
"(A,/)", advance=
"NO") string
1882 end subroutine put_line_ch
1886 subroutine put_line_unit_vs (unit, string, iostat)
1888 integer,
intent(in) :: unit
1889 type(varying_string),
intent(in) :: string
1890 integer,
intent(out),
optional :: iostat
1895 call put_line(unit, char(string), iostat)
1901 end subroutine put_line_unit_vs
1905 subroutine put_line_unit_ch (unit, string, iostat)
1907 integer,
intent(in) :: unit
1908 character(LEN=*),
intent(in) :: string
1909 integer,
intent(out),
optional :: iostat
1914 if(
PRESENT(iostat))
then 1915 write(unit=unit, fmt=
"(A,/)", advance=
"NO", iostat=iostat) string
1917 write(unit=unit, fmt=
"(A,/)", advance=
"NO") string
1924 end subroutine put_line_unit_ch
1928 elemental function extract_vs (string, start, finish) result (ext_string)
1930 type(varying_string),
intent(in) :: string
1931 integer,
intent(in),
optional :: start
1932 integer,
intent(in),
optional :: finish
1933 type(varying_string) :: ext_string
1937 ext_string = extract(char(string), start, finish)
1943 end function extract_vs
1947 elemental function extract_ch (string, start, finish) result (ext_string)
1949 character(LEN=*),
intent(in) :: string
1950 integer,
intent(in),
optional :: start
1951 integer,
intent(in),
optional :: finish
1952 type(varying_string) :: ext_string
1959 if(
PRESENT(start))
then 1960 start_ = max(1, start)
1965 if(
PRESENT(finish))
then 1966 finish_ = min(len(string), finish)
1968 finish_ = len(string)
1971 ext_string = var_str(string(start_:finish_))
1977 end function extract_ch
1981 elemental function insert_vs_vs (string, start, substring) result (ins_string)
1983 type(varying_string),
intent(in) :: string
1984 integer,
intent(in) :: start
1985 type(varying_string),
intent(in) :: substring
1986 type(varying_string) :: ins_string
1990 ins_string = insert(char(string), start, char(substring))
1996 end function insert_vs_vs
2000 elemental function insert_ch_vs (string, start, substring) result (ins_string)
2002 character(LEN=*),
intent(in) :: string
2003 integer,
intent(in) :: start
2004 type(varying_string),
intent(in) :: substring
2005 type(varying_string) :: ins_string
2009 ins_string = insert(string, start, char(substring))
2015 end function insert_ch_vs
2019 elemental function insert_vs_ch (string, start, substring) result (ins_string)
2021 type(varying_string),
intent(in) :: string
2022 integer,
intent(in) :: start
2023 character(LEN=*),
intent(in) :: substring
2024 type(varying_string) :: ins_string
2028 ins_string = insert(char(string), start, substring)
2034 end function insert_vs_ch
2038 elemental function insert_ch_ch (string, start, substring) result (ins_string)
2040 character(LEN=*),
intent(in) :: string
2041 integer,
intent(in) :: start
2042 character(LEN=*),
intent(in) :: substring
2043 type(varying_string) :: ins_string
2050 start_ = max(1, min(start, len(string)+1))
2052 ins_string = var_str(string(:start_-1)//substring//string(start_:))
2058 end function insert_ch_ch
2062 elemental function remove_vs (string, start, finish) result (rem_string)
2064 type(varying_string),
intent(in) :: string
2065 integer,
intent(in),
optional :: start
2066 integer,
intent(in),
optional :: finish
2067 type(varying_string) :: rem_string
2071 rem_string = remove(char(string), start, finish)
2077 end function remove_vs
2081 elemental function remove_ch (string, start, finish) result (rem_string)
2083 character(LEN=*),
intent(in) :: string
2084 integer,
intent(in),
optional :: start
2085 integer,
intent(in),
optional :: finish
2086 type(varying_string) :: rem_string
2093 if(
PRESENT(start))
then 2094 start_ = max(1, start)
2099 if(
PRESENT(finish))
then 2100 finish_ = min(len(string), finish)
2102 finish_ = len(string)
2105 if(finish_ >= start_)
then 2106 rem_string = var_str(string(:start_-1)//string(finish_+1:))
2115 end function remove_ch
2119 elemental function replace_vs_vs_auto (string, start, substring) result (rep_string)
2121 type(varying_string),
intent(in) :: string
2122 integer,
intent(in) :: start
2123 type(varying_string),
intent(in) :: substring
2124 type(varying_string) :: rep_string
2129 rep_string = replace(char(string), start, max(start, 1)+len(substring)-1, char(substring))
2135 end function replace_vs_vs_auto
2139 elemental function replace_ch_vs_auto (string, start, substring) result (rep_string)
2141 character(LEN=*),
intent(in) :: string
2142 integer,
intent(in) :: start
2143 type(varying_string),
intent(in) :: substring
2144 type(varying_string) :: rep_string
2149 rep_string = replace(string, start, max(start, 1)+len(substring)-1, char(substring))
2155 end function replace_ch_vs_auto
2159 elemental function replace_vs_ch_auto (string, start, substring) result (rep_string)
2161 type(varying_string),
intent(in) :: string
2162 integer,
intent(in) :: start
2163 character(LEN=*),
intent(in) :: substring
2164 type(varying_string) :: rep_string
2169 rep_string = replace(char(string), start, max(start, 1)+len(substring)-1, substring)
2175 end function replace_vs_ch_auto
2179 elemental function replace_ch_ch_auto (string, start, substring) result (rep_string)
2181 character(LEN=*),
intent(in) :: string
2182 integer,
intent(in) :: start
2183 character(LEN=*),
intent(in) :: substring
2184 type(varying_string) :: rep_string
2189 rep_string = replace(string, start, max(start, 1)+len(substring)-1, substring)
2195 end function replace_ch_ch_auto
2199 elemental function replace_vs_vs_fixed (string, start, finish, substring) result (rep_string)
2201 type(varying_string),
intent(in) :: string
2202 integer,
intent(in) :: start
2203 integer,
intent(in) :: finish
2204 type(varying_string),
intent(in) :: substring
2205 type(varying_string) :: rep_string
2210 rep_string = replace(char(string), start, finish, char(substring))
2216 end function replace_vs_vs_fixed
2222 elemental function replace_ch_vs_fixed (string, start, finish, substring) result (rep_string)
2224 character(LEN=*),
intent(in) :: string
2225 integer,
intent(in) :: start
2226 integer,
intent(in) :: finish
2227 type(varying_string),
intent(in) :: substring
2228 type(varying_string) :: rep_string
2233 rep_string = replace(string, start, finish, char(substring))
2239 end function replace_ch_vs_fixed
2243 elemental function replace_vs_ch_fixed (string, start, finish, substring) result (rep_string)
2245 type(varying_string),
intent(in) :: string
2246 integer,
intent(in) :: start
2247 integer,
intent(in) :: finish
2248 character(LEN=*),
intent(in) :: substring
2249 type(varying_string) :: rep_string
2254 rep_string = replace(char(string), start, finish, substring)
2260 end function replace_vs_ch_fixed
2264 elemental function replace_ch_ch_fixed (string, start, finish, substring) result (rep_string)
2266 character(LEN=*),
intent(in) :: string
2267 integer,
intent(in) :: start
2268 integer,
intent(in) :: finish
2269 character(LEN=*),
intent(in) :: substring
2270 type(varying_string) :: rep_string
2278 start_ = max(1, start)
2279 finish_ = min(len(string), finish)
2281 if(finish_ < start_)
then 2282 rep_string = insert(string, start_, substring)
2284 rep_string = var_str(string(:start_-1)//substring//string(finish_+1:))
2291 end function replace_ch_ch_fixed
2295 elemental function replace_vs_vs_vs_target (string, target, substring, every, back) result (rep_string)
2297 type(varying_string),
intent(in) :: string
2298 type(varying_string),
intent(in) :: target
2299 type(varying_string),
intent(in) :: substring
2300 logical,
intent(in),
optional :: every
2301 logical,
intent(in),
optional :: back
2302 type(varying_string) :: rep_string
2308 rep_string = replace(char(string), char(
target), char(substring), every, back)
2314 end function replace_vs_vs_vs_target
2318 elemental function replace_ch_vs_vs_target (string, target, substring, every, back) result (rep_string)
2320 character(LEN=*),
intent(in) :: string
2321 type(varying_string),
intent(in) :: target
2322 type(varying_string),
intent(in) :: substring
2323 logical,
intent(in),
optional :: every
2324 logical,
intent(in),
optional :: back
2325 type(varying_string) :: rep_string
2331 rep_string = replace(string, char(
target), char(substring), every, back)
2337 end function replace_ch_vs_vs_target
2341 elemental function replace_vs_ch_vs_target (string, target, substring, every, back) result (rep_string)
2343 type(varying_string),
intent(in) :: string
2344 character(LEN=*),
intent(in) :: target
2345 type(varying_string),
intent(in) :: substring
2346 logical,
intent(in),
optional :: every
2347 logical,
intent(in),
optional :: back
2348 type(varying_string) :: rep_string
2354 rep_string = replace(char(string),
target, char(substring), every, back)
2360 end function replace_vs_ch_vs_target
2364 elemental function replace_ch_ch_vs_target (string, target, substring, every, back) result (rep_string)
2366 character(LEN=*),
intent(in) :: string
2367 character(LEN=*),
intent(in) :: target
2368 type(varying_string),
intent(in) :: substring
2369 logical,
intent(in),
optional :: every
2370 logical,
intent(in),
optional :: back
2371 type(varying_string) :: rep_string
2377 rep_string = replace(string,
target, char(substring), every, back)
2383 end function replace_ch_ch_vs_target
2387 elemental function replace_vs_vs_ch_target (string, target, substring, every, back) result (rep_string)
2389 type(varying_string),
intent(in) :: string
2390 type(varying_string),
intent(in) :: target
2391 character(LEN=*),
intent(in) :: substring
2392 logical,
intent(in),
optional :: every
2393 logical,
intent(in),
optional :: back
2394 type(varying_string) :: rep_string
2400 rep_string = replace(char(string), char(
target), substring, every, back)
2406 end function replace_vs_vs_ch_target
2410 elemental function replace_ch_vs_ch_target (string, target, substring, every, back) result (rep_string)
2412 character(LEN=*),
intent(in) :: string
2413 type(varying_string),
intent(in) :: target
2414 character(LEN=*),
intent(in) :: substring
2415 logical,
intent(in),
optional :: every
2416 logical,
intent(in),
optional :: back
2417 type(varying_string) :: rep_string
2423 rep_string = replace(string, char(
target), substring, every, back)
2429 end function replace_ch_vs_ch_target
2433 elemental function replace_vs_ch_ch_target (string, target, substring, every, back) result (rep_string)
2435 type(varying_string),
intent(in) :: string
2436 character(LEN=*),
intent(in) :: target
2437 character(LEN=*),
intent(in) :: substring
2438 logical,
intent(in),
optional :: every
2439 logical,
intent(in),
optional :: back
2440 type(varying_string) :: rep_string
2446 rep_string = replace(char(string),
target, substring, every, back)
2452 end function replace_vs_ch_ch_target
2456 elemental function replace_ch_ch_ch_target (string, target, substring, every, back) result (rep_string)
2458 character(LEN=*),
intent(in) :: string
2459 character(LEN=*),
intent(in) :: target
2460 character(LEN=*),
intent(in) :: substring
2461 logical,
intent(in),
optional :: every
2462 logical,
intent(in),
optional :: back
2463 type(varying_string) :: rep_string
2467 type(varying_string) :: work_string
2468 integer :: length_target
2477 if(len(
target) == 0)
then 2478 if(len(string) /= 0)
then 2481 rep_string = substring
2490 if(
PRESENT(every))
then 2496 if(
PRESENT(back))
then 2504 work_string = string
2506 length_target = len(
target)
2510 i_target = index(work_string,
target, back_)
2512 if(i_target == 0)
exit replace_loop
2515 rep_string = substring//extract(work_string, start=i_target+length_target)//rep_string
2516 work_string = extract(work_string, finish=i_target-1)
2518 rep_string = rep_string//extract(work_string, finish=i_target-1)//substring
2519 work_string = extract(work_string, start=i_target+length_target)
2522 if(.NOT. every_)
exit replace_loop
2527 rep_string = work_string//rep_string
2529 rep_string = rep_string//work_string
2536 end function replace_ch_ch_ch_target
2540 elemental subroutine split_vs (string, word, set, separator, back)
2542 type(varying_string),
intent(inout) :: string
2543 type(varying_string),
intent(out) :: word
2544 type(varying_string),
intent(in) :: set
2545 type(varying_string),
intent(out),
optional :: separator
2546 logical,
intent(in),
optional :: back
2550 call split_ch(string, word, char(set), separator, back)
2556 end subroutine split_vs
2560 elemental subroutine split_ch (string, word, set, separator, back)
2562 type(varying_string),
intent(inout) :: string
2563 type(varying_string),
intent(out) :: word
2564 character(LEN=*),
intent(in) :: set
2565 type(varying_string),
intent(out),
optional :: separator
2566 logical,
intent(in),
optional :: back
2569 integer :: i_separator
2573 if(
PRESENT(back))
then 2579 i_separator = scan(string, set, back_)
2581 if(i_separator /= 0)
then 2584 word = extract(string, start=i_separator+1)
2585 if(
PRESENT(separator)) separator = extract(string, start=i_separator, finish=i_separator)
2586 string = extract(string, finish=i_separator-1)
2588 word = extract(string, finish=i_separator-1)
2589 if(
PRESENT(separator)) separator = extract(string, start=i_separator, finish=i_separator)
2590 string = extract(string, start=i_separator+1)
2596 if(
PRESENT(separator)) separator =
"" 2605 end subroutine split_ch
2608 FUNCTION c_ptr_new_vs(string) RESULT(c_ptr_new)
2609 TYPE(varying_string),
INTENT(in),
TARGET :: string
2610 TYPE(c_ptr) :: c_ptr_new
2612 c_ptr_new = c_loc(string%chars(1))
2614 END FUNCTION c_ptr_new_vs
2617 end module iso_varying_string