Line data Source code
1 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3 : !!!! !!!!
4 : !!!! ParaMonte: Parallel Monte Carlo and Machine Learning Library. !!!!
5 : !!!! !!!!
6 : !!!! Copyright (C) 2012-present, The Computational Data Science Lab !!!!
7 : !!!! !!!!
8 : !!!! This file is part of the ParaMonte library. !!!!
9 : !!!! !!!!
10 : !!!! LICENSE !!!!
11 : !!!! !!!!
12 : !!!! https://github.com/cdslaborg/paramonte/blob/main/LICENSE.md !!!!
13 : !!!! !!!!
14 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
16 :
17 : !> \brief
18 : !> This file contains the implementation details of the routines under the generic interfaces of [pm_strASCII](@ref pm_strASCII).
19 : !>
20 : !> \finmain
21 : !>
22 : !> \author
23 : !> \AmirShahmoradi, September 1, 2017, 11:35 PM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
24 :
25 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
26 :
27 : character(1,SKC), parameter :: SPACE_SKC = achar(32, SKC)
28 : #if getLocSpace_ENABLED
29 14 : do locSpace = 1_IK, len(str, kind = IK)
30 11 : if (str(locSpace:locSpace) /= SPACE_SKC) cycle
31 9 : return
32 : end do
33 : locSpace = 0_IK
34 : #elif getLocNonSpace_ENABLED
35 3296 : do locNonSpace = 1_IK, len(str, kind = IK)
36 3290 : if (str(locNonSpace:locNonSpace) == SPACE_SKC) cycle
37 26 : return
38 : end do
39 : locNonSpace = 0_IK
40 : #elif isCharDigit_ENABLED
41 : !integer(IK) :: j
42 : !charIsDigit = .false._LK
43 : !loopOverDigit: do j = 1_IK,10_IK
44 : ! if (chr == DIGIT_VEC_SK(j)) then
45 : ! charIsDigit = .true._LK
46 : ! exit loopOverDigit
47 : ! end if
48 : !end do loopOverDigit
49 3496 : charIsDigit = SKC_"0" <= chr .and. chr <= SKC_"9"
50 : #elif isStrDigitAll_ENABLED
51 : integer(IK) :: i
52 8 : if (len(str, kind = IK) > 0_IK) then
53 14 : loopOverStr: do i = 1_IK, len(str, kind = IK)
54 12 : if (isCharDigit(str(i:i))) cycle loopOverStr
55 : strIsDigitAll = .false._LK
56 9 : return
57 : end do loopOverStr
58 : strIsDigitAll = .true._LK
59 : else
60 : strIsDigitAll = .false._LK
61 : end if
62 : #elif isStrDigitAny_ENABLED
63 : integer(IK) :: i
64 8 : if (len(str, kind = IK) > 0_IK) then
65 10 : loopOverStr: do i = 1_IK, len(str, kind = IK)
66 10 : if (isCharDigit(str(i:i))) then
67 : strIsDigitAny = .true._LK
68 : return
69 : end if
70 : end do loopOverStr
71 : end if
72 : strIsDigitAny = .false._LK
73 : #elif isStrDigit_ENABLED
74 : integer(IK) :: i
75 : do concurrent(i = 1_IK : len(str, kind = IK))
76 13 : StrIsNumeric(i) = isCharDigit(str(i:i))
77 : end do
78 : #elif isStrInteger_ENABLED
79 : integer(IK) :: i, lenStr
80 : strIsInteger = .false._LK
81 3198 : lenStr = len(str, kind = IK)
82 3198 : if (lenStr == 0_IK) return
83 3196 : i = getLocNonSpace(str)
84 3196 : if (i == 0_IK) return
85 3195 : if (str(i:i) == SKC_"+" .or. str(i:i) == SKC_"-") i = i + 1_IK
86 3195 : if (i > lenStr) return
87 1462 : do
88 4655 : if (i > lenStr) then
89 : strIsInteger = .true._LK
90 : return
91 : end if
92 3212 : if (.not. isCharDigit(str(i:i))) exit
93 1462 : i = i + 1_IK
94 : end do
95 1750 : if (str(i:lenStr) == SPACE_SKC) strIsInteger = .true._LK
96 : #elif isStrComplex_ENABLED
97 : integer(IK) :: rebeg, refin
98 : integer(IK) :: imbeg, imfin
99 : integer(IK) :: i, lenStr
100 : strIsComplex = .false._LK
101 42 : lenStr = len(str, kind = IK)
102 42 : if (lenStr == 0_IK) return
103 : i = 0_IK
104 : do
105 53 : i = i + 1_IK
106 53 : if (i > lenStr) return
107 51 : if (str(i:i) == SPACE_SKC) cycle
108 38 : if (str(i:i) /= SKC_"(") return
109 : do
110 34 : i = i + 1_IK
111 34 : if (i > lenStr) return
112 34 : if (str(i:i) == SPACE_SKC) cycle
113 : rebeg = i
114 : do
115 64 : i = i + 1_IK
116 64 : if (i > lenStr) return
117 63 : if (str(i:i) == SPACE_SKC .or. str(i:i) == SKC_",") exit
118 23 : cycle
119 : end do
120 : refin = i - 1_IK
121 23 : if (str(i:i) == SPACE_SKC) then
122 : do
123 15 : i = i + 1_IK
124 15 : if (i > lenStr) return
125 15 : if (str(i:i) == SPACE_SKC) cycle
126 12 : if (str(i:i) == SKC_",") exit
127 : end do
128 : end if
129 : do
130 31 : i = i + 1_IK
131 31 : if (i > lenStr) return
132 29 : if (str(i:i) == SPACE_SKC) cycle
133 8 : exit
134 : end do
135 : imbeg = i
136 : do
137 45 : i = i + 1_IK
138 45 : if (i > lenStr) return
139 45 : if (str(i:i) == SPACE_SKC .or. str(i:i) == SKC_")") exit
140 : end do
141 : imfin = i - 1_IK
142 21 : if (str(i:i) == SKC_")") then
143 : do
144 38 : i = i + 1_IK
145 38 : if (i > lenStr) exit
146 24 : if (str(i:i) == SPACE_SKC) cycle
147 : return ! LCOV_EXCL_LINE
148 : end do
149 : else ! str(i:i) == SPACE_SKC
150 : do
151 14 : i = i + 1_IK
152 14 : if (i > lenStr) exit
153 10 : if (str(i:i) == SPACE_SKC) cycle
154 11 : if (str(i:i) /= SKC_")") return
155 : end do
156 : end if
157 18 : strIsComplex = isStrReal(str(rebeg:refin)) .and. isStrReal(str(imbeg:imfin))
158 23 : return
159 : end do
160 : end do
161 : #elif isStrReal_ENABLED
162 : integer(IK) :: i, lenStr
163 : logical(LK) :: digitized
164 : strIsReal = .false._LK
165 74 : lenStr = len(str, kind = IK)
166 74 : if (lenStr == 0_IK) return
167 72 : i = getLocNonSpace(str)
168 72 : if (i == 0_IK) return ! str is all whitespace.
169 : !write(*,*) i, str(i:i)
170 70 : if (str(i:i) == SKC_"+" .or. str(i:i) == SKC_"-") then
171 41 : if (i == lenStr) return
172 : else
173 29 : i = i - 1_IK
174 : end if
175 : ! Skip any digits after sign
176 : digitized = .false._LK
177 : do
178 122 : i = i + 1_IK
179 122 : if (i > lenStr) then ! this never happens in the first round of loop.
180 : strIsReal = .true._LK
181 : return
182 96 : elseif (isCharDigit(str(i:i))) then
183 : digitized = .true._LK
184 : cycle
185 : end if
186 : exit
187 : end do
188 : !write(*,*) i, """"//str(i:i)//""""
189 42 : if (str(i:i) == SKC_".") then
190 : do
191 48 : i = i + 1_IK
192 48 : if (i > lenStr) then
193 : strIsReal = digitized
194 : !write(*,*) i, """"//str//""""
195 12 : return
196 36 : elseif (isCharDigit(str(i:i))) then
197 : digitized = .true._LK
198 : cycle
199 : end if
200 18 : if (digitized) exit
201 18 : return
202 : end do
203 : end if
204 : !write(*,*) i, """"//str//""""
205 30 : if (str(i:i) == SKC_"e" .or. str(i:i) == SKC_"E" .or. str(i:i) == SKC_"d" .or. str(i:i) == SKC_"D") then
206 17 : i = i + 1_IK
207 17 : if (i > lenStr) return
208 17 : if (str(i:i) == SKC_"+" .or. str(i:i) == SKC_"-") then
209 8 : if (i == lenStr) return
210 8 : i = i + 1_IK
211 : end if
212 17 : if (.not. isCharDigit(str(i:i))) return
213 : do
214 23 : i = i + 1_IK
215 23 : if (i > lenStr) then ! This never happens on the first iteration.
216 : strIsReal = .true._LK
217 : return
218 12 : elseif (isCharDigit(str(i:i))) then
219 : cycle
220 : end if
221 : exit ! LCOV_EXCL_LINE
222 : end do
223 : end if
224 19 : if (str(i:lenStr) == SPACE_SKC) strIsReal = .true._LK ! all the rest must be whitespace.
225 : #elif isStrNumber_ENABLED
226 16 : strIsNumber = isStrInteger(str) .or. isStrReal(str) .or. isStrComplex(str)
227 : #elif isCharUpper_ENABLED
228 : !charIsUpper = any(ALPHA_UPPER_VEC_SK == chr)
229 94 : charIsUpper = SKC_"A" <= chr .and. chr <= SKC_"Z"
230 : #elif isCharLower_ENABLED
231 : !charIsLower = any(ALPHA_LOWER_VEC_SK == chr)
232 94 : charIsLower = SKC_"a" <= chr .and. chr <= SKC_"z"
233 : #elif isStrUpperAll_ENABLED
234 : integer(IK) :: i
235 21 : if (len(str, kind = IK) > 0_IK) then
236 51 : loopOverStr: do i = 1_IK, len(str, kind = IK)
237 40 : if (isCharUpper(str(i:i))) cycle
238 : strIsUpperAll = .false._LK
239 41 : return
240 : end do loopOverStr
241 : strIsUpperAll = .true._LK
242 : else
243 : strIsUpperAll = .false._LK
244 : end if
245 : #elif isStrLowerAll_ENABLED
246 : integer(IK) :: i
247 21 : if (len(str, kind = IK) > 0_IK) then
248 50 : loopOverStr: do i = 1_IK, len(str, kind = IK)
249 39 : if (isCharLower(str(i:i))) cycle
250 : strIsLowerAll = .false._LK
251 40 : return
252 : end do loopOverStr
253 : strIsLowerAll = .true._LK
254 : else
255 : strIsLowerAll = .false._LK
256 : end if
257 : #elif isStrUpperAny_ENABLED
258 : integer(IK) :: i
259 21 : if (len(str, kind = IK) > 0_IK) then
260 27 : loopOverStr: do i = 1_IK, len(str, kind = IK)
261 27 : if (isCharUpper(str(i:i))) then
262 : strIsUpperAny = .true._LK
263 : return
264 : end if
265 : end do loopOverStr
266 : end if
267 : strIsUpperAny = .false._LK
268 : #elif isStrLowerAny_ENABLED
269 : integer(IK) :: i
270 21 : if (len(str, kind = IK) > 0_IK) then
271 28 : loopOverStr: do i = 1_IK, len(str, kind = IK)
272 28 : if (isCharLower(str(i:i))) then
273 : strIsLowerAny = .true._LK
274 : return
275 : end if
276 : end do loopOverStr
277 : end if
278 : strIsLowerAny = .false._LK
279 : #elif isStrUpper_ENABLED
280 : integer(IK) :: i
281 : loopOverStr: do concurrent(i = 1_IK : len(str, kind = IK))
282 28 : StrIsUpper(i) = isCharUpper(str(i:i))
283 : end do loopOverStr
284 : #elif isStrLower_ENABLED
285 : integer(IK) :: i
286 : loopOverStr: do concurrent(i = 1_IK : len(str, kind = IK))
287 28 : StrIsLower(i) = isCharLower(str(i:i))
288 : end do loopOverStr
289 : #elif isCharAlphaNum_ENABLED
290 8 : charIsAlphaNum = (SKC_"0" <= chr .and. chr <= SKC_"9") .or. (SKC_"A" <= chr .and. chr <= SKC_"Z") .or. (SKC_"a" <= chr .and. chr <= SKC_"z")
291 : #elif isStrAlphaNumAll_ENABLED
292 : integer(IK) :: i
293 14 : if (len(str, kind = IK) > 0_IK) then
294 50 : do i = 1_IK, len(str, kind = IK)
295 : !if (any(ALPHANUM_VEC_SK == str(i:i))) cycle
296 42 : if ((SKC_"0" <= str(i:i) .and. str(i:i) <= SKC_"9") .or. (SKC_"A" <= str(i:i) .and. str(i:i) <= SKC_"Z") .or. (SKC_"a" <= str(i:i) .and. str(i:i) <= SKC_"z")) cycle
297 : strIsAlphaNumAll = .false._LK
298 45 : return
299 : end do
300 : strIsAlphaNumAll = .true._LK
301 : else
302 : strIsAlphaNumAll = .false._LK
303 : end if
304 : #elif isStrAlphaNumAny_ENABLED
305 : integer(IK) :: i
306 14 : if (len(str, kind = IK) > 0_IK) then
307 23 : do i = 1_IK, len(str, kind = IK)
308 23 : if ((SKC_"0" <= str(i:i) .and. str(i:i) <= SKC_"9") .or. (SKC_"A" <= str(i:i) .and. str(i:i) <= SKC_"Z") .or. (SKC_"a" <= str(i:i) .and. str(i:i) <= SKC_"z")) then
309 : strIsAlphaNumAny = .true._LK
310 : return
311 : end if
312 : end do
313 : end if
314 : strIsAlphaNumAny = .false._LK
315 : #elif isStrAlphaNum_ENABLED
316 : integer(IK) :: i
317 : do concurrent(i = 1_IK : len(str, kind = IK))
318 34 : StrIsAlphaNum(i) = logical((SKC_"0" <= str(i:i) .and. str(i:i) <= SKC_"9") .or. (SKC_"A" <= str(i:i) .and. str(i:i) <= SKC_"Z") .or. (SKC_"a" <= str(i:i) .and. str(i:i) <= SKC_"z"), kind = LK)
319 : end do
320 : #elif isCharAlpha_ENABLED
321 120 : charIsAlpha = logical((SKC_"A" <= chr .and. chr <= SKC_"Z") .or. (SKC_"a" <= chr .and. chr <= SKC_"z"), LK)
322 : #elif isStrAlphaAll_ENABLED
323 : integer(IK) :: i
324 18 : if (len(str, kind = IK) > 0_IK) then
325 61 : do i = 1_IK, len(str, kind = IK)
326 : !if (any(ALPHANUM_VEC_SK == str(i:i))) cycle
327 53 : if ((SKC_"A" <= str(i:i) .and. str(i:i) <= SKC_"Z") .or. (SKC_"a" <= str(i:i) .and. str(i:i) <= SKC_"z")) cycle
328 : strIsAlphaAll = .false._LK
329 52 : return
330 : end do
331 : strIsAlphaAll = .true._LK
332 : else
333 : strIsAlphaAll = .false._LK
334 : end if
335 : #elif isStrAlphaAny_ENABLED
336 : integer(IK) :: i
337 18 : if (len(str, kind = IK) > 0_IK) then
338 30 : do i = 1_IK, len(str, kind = IK)
339 30 : if ((SKC_"A" <= str(i:i) .and. str(i:i) <= SKC_"Z") .or. (SKC_"a" <= str(i:i) .and. str(i:i) <= SKC_"z")) then
340 : strIsAlphaAny = .true._LK
341 : return
342 : end if
343 : end do
344 : end if
345 : strIsAlphaAny = .false._LK
346 : #elif isStrAlpha_ENABLED
347 : integer(IK) :: i
348 : do concurrent(i = 1_IK : len(str, kind = IK))
349 30 : StrIsAlpha(i) = logical((SKC_"A" <= str(i:i) .and. str(i:i) <= SKC_"Z") .or. (SKC_"a" <= str(i:i) .and. str(i:i) <= SKC_"z"), kind = LK)
350 : end do
351 : #elif getStrUpper_ENABLED
352 : integer(IK) :: i
353 : do concurrent(i = 1_IK : len(str, kind = IK))
354 3477 : if (SKC_"a" > str(i:i) .or. str(i:i) > SKC_"z") then
355 1885 : strUpper(i:i) = str(i:i)
356 : else
357 1504 : strUpper(i:i) = char(ichar(str(i:i), kind = IK) + UPPER_MINUS_LOWER_IK, kind = SKC)
358 : end if
359 : end do
360 : #elif getCharUpper_ENABLED
361 7 : if (SKC_"a" > chr .or. chr > SKC_"z") then
362 5 : chrUpper = chr
363 : else
364 2 : chrUpper = char(ichar(chr, kind = IK) + UPPER_MINUS_LOWER_IK, kind = SKC)
365 : end if
366 : #elif setCharUpper_ENABLED
367 7 : if (SKC_"a" <= chr .and. chr <= SKC_"z") chr = char(ichar(chr, kind = IK) + UPPER_MINUS_LOWER_IK, kind = SKC)
368 : #elif getCharLower_ENABLED
369 187 : if (SKC_"A" > chr .or. chr > SKC_"Z") then
370 103 : chrLower = chr
371 : else
372 84 : chrLower = char(ichar(chr, kind = IK) - UPPER_MINUS_LOWER_IK, kind = SKC)
373 : end if
374 : #elif setCharLower_ENABLED
375 7 : if (SKC_"A" <= chr .and. chr <= SKC_"Z") chr = char(ichar(chr, kind = IK) - UPPER_MINUS_LOWER_IK, kind = SKC)
376 : #elif setStrUpper_ENABLED
377 : integer(IK) :: i
378 10 : do concurrent(i = 1_IK : len(str, kind = IK))
379 68 : if (SKC_"a" <= str(i:i) .and. str(i:i) <= SKC_"z") str(i:i) = char(ichar(str(i:i), kind = IK) + UPPER_MINUS_LOWER_IK, kind = SKC)
380 : end do
381 : #elif getStrLower_ENABLED
382 : integer(IK) :: i
383 : do concurrent(i = 1_IK : len(str, kind = IK))
384 144182 : if (SKC_"A" > str(i:i) .or. str(i:i) > SKC_"Z") then
385 124636 : strLower(i:i) = str(i:i)
386 : else
387 14386 : strLower(i:i) = char(ichar(str(i:i), kind = IK) - UPPER_MINUS_LOWER_IK, kind = SKC)
388 : end if
389 : end do
390 : #elif setStrLower_ENABLED
391 : integer(IK) :: i
392 66 : do concurrent(i = 1_IK : len(str, kind = IK))
393 3634 : if (SKC_"A" <= str(i:i) .and. str(i:i) <= SKC_"Z") str(i:i) = char(ichar(str(i:i), kind = IK) - UPPER_MINUS_LOWER_IK, kind = SKC)
394 : end do
395 : #elif getStrQuoted_ENABLED || setStrQuoted_ENABLED
396 991039 : integer(IK) :: i, counter, pos, lenSeg, lenStr, lenStrQuoted, Loc(0:len(str))
397 : lenStr = len(str, IK)
398 : counter = 0_IK
399 1198589 : do i = 1_IK, lenStr
400 1198589 : if (str(i:i) == SKC_"""") then
401 11927 : counter = counter + 1_IK
402 11927 : Loc(counter) = i
403 : end if
404 : end do
405 991039 : lenStrQuoted = lenStr + counter + 2_IK
406 991039 : allocate(character(lenStrQuoted, SKC) :: strQuoted)
407 991039 : strQuoted(1:1) = SKC_""""
408 991039 : Loc(0) = 0_IK
409 : pos = 1_IK
410 1002966 : do i = 1_IK, counter
411 11927 : lenSeg = Loc(i) - Loc(i-1_IK)
412 11927 : strQuoted(pos + 1_IK : pos + lenSeg) = str(Loc(i-1_IK) + 1_IK : Loc(i))
413 11927 : pos = pos + lenSeg + 1_IK
414 1002966 : strQuoted(pos : pos) = SKC_""""
415 : end do
416 991039 : strQuoted(pos + 1_IK : lenStrQuoted - 1_IK) = str(Loc(counter) + 1 : lenStr)
417 991039 : strQuoted(lenStrQuoted : lenStrQuoted) = SKC_""""
418 : #elif getAsciiFromEscaped_ENABLED || setAsciiFromEscaped_ENABLED
419 : integer(IK) :: i, j, lenStr, code
420 : #if getAsciiFromEscaped_ENABLED
421 : integer(IK) :: endloc
422 20 : lenStr = len(str, IK)
423 20 : allocate(character(lenStr,SKC) :: ascii)
424 : #elif setAsciiFromEscaped_ENABLED && Rep_ENABLED
425 1445 : lenStr = len(str, IK)
426 : #define ASCII str
427 : #elif setAsciiFromEscaped_ENABLED && New_ENABLED
428 5 : lenStr = len(str, IK)
429 15 : CHECK_ASSERTION(__LINE__, lenStr <= len(ascii,IK), SK_"@setAsciiFromEscaped(): The condition `len(str) <= len(ascii)` must hold. len(str), len(ascii) "//getStr([len(str,IK), len(ascii,IK)])) ! fpp
430 : #else
431 : #error "Unrecognized interface."
432 : #endif
433 1450 : endloc = 0_IK
434 : i = 1_IK
435 107495 : do
436 108965 : if (i < lenStr) then
437 : code = -1_IK
438 107495 : if (str(i:i) == SKC_"\") then
439 79 : j = i + 1_IK
440 79 : if (str(j:j) == SKC_"n") then
441 : code = 10_IK
442 : elseif (str(j:j) == SKC_"r") then
443 : code = 13_IK
444 : elseif (str(j:j) == SKC_"t") then
445 : code = 9_IK
446 : elseif (str(j:j) == SKC_"v") then
447 : code = 11_IK
448 : elseif (str(j:j) == SKC_"a") then
449 : code = 7_IK
450 : elseif (str(j:j) == SKC_"b") then
451 : code = 8_IK
452 : elseif (str(j:j) == SKC_"f") then
453 : code = 12_IK
454 : elseif (str(j:j) == SKC_"\") then
455 : code = 92_IK
456 : elseif (str(j:j) == SKC_"'") then
457 : code = 39_IK
458 : elseif (str(j:j) == SKC_'"') then
459 : code = 34_IK
460 : elseif (str(j:j) == SKC_"?") then
461 : code = 63_IK
462 39 : elseif (SKC_"0" <= str(j:j) .and. str(j:j) < SKC_"8") then ! is octal
463 : do
464 36 : if (j == lenStr) exit
465 36 : j = j + 1_IK
466 36 : if (SKC_"0" <= str(j:j) .and. str(j:j) < SKC_"8") cycle
467 : j = j - 1_IK
468 20 : exit
469 : end do
470 16 : code = getDecimal(str(i + 1_IK : j), 8_IK)
471 23 : elseif (str(j:j) == SKC_"x") then ! is hex
472 : do
473 20 : if (j == lenStr) exit
474 20 : j = j + 1_IK
475 20 : if (isCharDigit(str(j:j)) .or. (SKC_"A" <= str(j:j) .and. str(j:j) < SKC_"G")) cycle
476 : j = j - 1_IK
477 12 : exit
478 : end do
479 8 : if (j > i + 1_IK) code = getDecimal(str(i + 2_IK : j), 16_IK)
480 15 : elseif (str(j:j) == SKC_"u") then ! is UTF-8 four digit hex
481 : #define SET_ASCII_CODE(STR_OFFSET) \
482 : do; \
483 : if (j == lenStr) exit; \
484 : j = j + 1_IK; \
485 : if (isCharDigit(str(j:j)) .or. (SKC_"A" <= str(j:j) .and. str(j:j) < SKC_"G")) then; \
486 : if (j < i + STR_OFFSET) cycle; \
487 : exit; \
488 : end if; \
489 : j = j - 1_IK; \
490 : exit; \
491 : end do; \
492 : if (j == i + STR_OFFSET) code = getDecimal(str(i + 2_IK : j), 16_IK);
493 16 : SET_ASCII_CODE(5_IK) ! fpp
494 11 : elseif (str(j:j) == SKC_"U") then ! is UTF-8 four digit hex
495 40 : SET_ASCII_CODE(9_IK) ! fpp
496 : #undef SET_ASCII_CODE
497 : end if
498 : else
499 : j = i
500 : end if
501 107495 : endloc = endloc + 1_IK
502 107495 : if (code < 0_IK .or. code > 127_IK) then
503 107427 : ASCII(endloc : endloc + j - i) = str(i:j) ! fpp
504 17192 : endloc = endloc + j - i
505 : else
506 68 : ASCII(endloc : endloc) = achar(code, kind = SKC) ! fpp
507 : end if
508 107495 : i = j + 1_IK
509 : else
510 1470 : if (i == lenStr) then
511 1458 : endloc = endloc + 1_IK
512 1458 : ASCII(endloc : endloc) = str(i:i)
513 : end if
514 : #if getAsciiFromEscaped_ENABLED
515 20 : ASCII = ASCII(1:endloc) ! fpp
516 : #endif
517 4410 : CHECK_ASSERTION(__LINE__, endloc <= lenStr, SK_"The condition `endloc <= lenStr` must hold. endloc, lenStr = "//getStr([endloc, lenStr]))
518 1470 : return
519 : end if
520 : end do
521 : error stop "Internal library error occurred. The procedure should not reach this line." ! LCOV_EXCL_LINE
522 : #else
523 : #error "Unrecognized interface."
524 : #endif
525 : #undef ASCII
|
