1 | //===-- runtime/namelist.cpp ----------------------------------------------===// |
2 | // |
3 | // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. |
4 | // See https://llvm.org/LICENSE.txt for license information. |
5 | // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception |
6 | // |
7 | //===----------------------------------------------------------------------===// |
8 | |
9 | #include "namelist.h" |
10 | #include "descriptor-io.h" |
11 | #include "emit-encoded.h" |
12 | #include "io-stmt.h" |
13 | #include "flang/Runtime/io-api.h" |
14 | #include <algorithm> |
15 | #include <cstring> |
16 | #include <limits> |
17 | |
18 | namespace Fortran::runtime::io { |
19 | |
20 | // Max size of a group, symbol or component identifier that can appear in |
21 | // NAMELIST input, plus a byte for NUL termination. |
22 | static constexpr std::size_t nameBufferSize{201}; |
23 | |
24 | static inline char32_t GetComma(IoStatementState &io) { |
25 | return io.mutableModes().editingFlags & decimalComma ? char32_t{';'} |
26 | : char32_t{','}; |
27 | } |
28 | |
29 | bool IONAME(OutputNamelist)(Cookie cookie, const NamelistGroup &group) { |
30 | IoStatementState &io{*cookie}; |
31 | io.CheckFormattedStmtType<Direction::Output>(name: "OutputNamelist" ); |
32 | io.mutableModes().inNamelist = true; |
33 | ConnectionState &connection{io.GetConnectionState()}; |
34 | // Internal function to advance records and convert case |
35 | const auto EmitUpperCase{[&](const char *prefix, std::size_t prefixLen, |
36 | const char *str, char suffix) -> bool { |
37 | if ((connection.NeedAdvance(prefixLen) && |
38 | !(io.AdvanceRecord() && EmitAscii(to&: io, data: " " , chars: 1))) || |
39 | !EmitAscii(to&: io, data: prefix, chars: prefixLen) || |
40 | (connection.NeedAdvance(std::strlen(s: str) + (suffix != ' ')) && |
41 | !(io.AdvanceRecord() && EmitAscii(to&: io, data: " " , chars: 1)))) { |
42 | return false; |
43 | } |
44 | for (; *str; ++str) { |
45 | char up{*str >= 'a' && *str <= 'z' ? static_cast<char>(*str - 'a' + 'A') |
46 | : *str}; |
47 | if (!EmitAscii(to&: io, data: &up, chars: 1)) { |
48 | return false; |
49 | } |
50 | } |
51 | return suffix == ' ' || EmitAscii(to&: io, data: &suffix, chars: 1); |
52 | }}; |
53 | // &GROUP |
54 | if (!EmitUpperCase(" &" , 2, group.groupName, ' ')) { |
55 | return false; |
56 | } |
57 | auto *listOutput{io.get_if<ListDirectedStatementState<Direction::Output>>()}; |
58 | char comma{static_cast<char>(GetComma(io))}; |
59 | char prefix{' '}; |
60 | for (std::size_t j{0}; j < group.items; ++j) { |
61 | // [,]ITEM=... |
62 | const NamelistGroup::Item &item{group.item[j]}; |
63 | if (listOutput) { |
64 | listOutput->set_lastWasUndelimitedCharacter(false); |
65 | } |
66 | if (!EmitUpperCase(&prefix, 1, item.name, '=')) { |
67 | return false; |
68 | } |
69 | prefix = comma; |
70 | if (const auto *addendum{item.descriptor.Addendum()}; |
71 | addendum && addendum->derivedType()) { |
72 | const NonTbpDefinedIoTable *table{group.nonTbpDefinedIo}; |
73 | if (!IONAME(OutputDerivedType)(cookie, item.descriptor, table)) { |
74 | return false; |
75 | } |
76 | } else if (!descr::DescriptorIO<Direction::Output>(io, item.descriptor)) { |
77 | return false; |
78 | } |
79 | } |
80 | // terminal / |
81 | return EmitUpperCase("/" , 1, "" , ' '); |
82 | } |
83 | |
84 | static constexpr bool IsLegalIdStart(char32_t ch) { |
85 | return (ch >= 'A' && ch <= 'Z') || (ch >= 'a' && ch <= 'z') || ch == '_' || |
86 | ch == '@'; |
87 | } |
88 | |
89 | static constexpr bool IsLegalIdChar(char32_t ch) { |
90 | return IsLegalIdStart(ch) || (ch >= '0' && ch <= '9'); |
91 | } |
92 | |
93 | static constexpr char NormalizeIdChar(char32_t ch) { |
94 | return static_cast<char>(ch >= 'A' && ch <= 'Z' ? ch - 'A' + 'a' : ch); |
95 | } |
96 | |
97 | static bool GetLowerCaseName( |
98 | IoStatementState &io, char buffer[], std::size_t maxLength) { |
99 | std::size_t byteLength{0}; |
100 | if (auto ch{io.GetNextNonBlank(byteCount&: byteLength)}) { |
101 | if (IsLegalIdStart(ch: *ch)) { |
102 | std::size_t j{0}; |
103 | do { |
104 | buffer[j] = NormalizeIdChar(ch: *ch); |
105 | io.HandleRelativePosition(byteOffset: byteLength); |
106 | ch = io.GetCurrentChar(byteCount&: byteLength); |
107 | } while (++j < maxLength && ch && IsLegalIdChar(ch: *ch)); |
108 | buffer[j++] = '\0'; |
109 | if (j <= maxLength) { |
110 | return true; |
111 | } |
112 | io.GetIoErrorHandler().SignalError( |
113 | msg: "Identifier '%s...' in NAMELIST input group is too long" , xs&: buffer); |
114 | } |
115 | } |
116 | return false; |
117 | } |
118 | |
119 | static std::optional<SubscriptValue> GetSubscriptValue(IoStatementState &io) { |
120 | std::optional<SubscriptValue> value; |
121 | std::size_t byteCount{0}; |
122 | std::optional<char32_t> ch{io.GetCurrentChar(byteCount)}; |
123 | bool negate{ch && *ch == '-'}; |
124 | if ((ch && *ch == '+') || negate) { |
125 | io.HandleRelativePosition(byteOffset: byteCount); |
126 | ch = io.GetCurrentChar(byteCount); |
127 | } |
128 | bool overflow{false}; |
129 | while (ch && *ch >= '0' && *ch <= '9') { |
130 | SubscriptValue was{value.value_or(0)}; |
131 | overflow |= was >= std::numeric_limits<SubscriptValue>::max() / 10; |
132 | value = 10 * was + *ch - '0'; |
133 | io.HandleRelativePosition(byteOffset: byteCount); |
134 | ch = io.GetCurrentChar(byteCount); |
135 | } |
136 | if (overflow) { |
137 | io.GetIoErrorHandler().SignalError( |
138 | msg: "NAMELIST input subscript value overflow" ); |
139 | return std::nullopt; |
140 | } |
141 | if (negate) { |
142 | if (value) { |
143 | return -*value; |
144 | } else { |
145 | io.HandleRelativePosition(byteOffset: -byteCount); // give back '-' with no digits |
146 | } |
147 | } |
148 | return value; |
149 | } |
150 | |
151 | static bool HandleSubscripts(IoStatementState &io, Descriptor &desc, |
152 | const Descriptor &source, const char *name) { |
153 | IoErrorHandler &handler{io.GetIoErrorHandler()}; |
154 | // Allow for blanks in subscripts; they're nonstandard, but not |
155 | // ambiguous within the parentheses. |
156 | SubscriptValue lower[maxRank], upper[maxRank], stride[maxRank]; |
157 | int j{0}; |
158 | std::size_t contiguousStride{source.ElementBytes()}; |
159 | bool ok{true}; |
160 | std::size_t byteCount{0}; |
161 | std::optional<char32_t> ch{io.GetNextNonBlank(byteCount)}; |
162 | char32_t comma{GetComma(io)}; |
163 | for (; ch && *ch != ')'; ++j) { |
164 | SubscriptValue dimLower{0}, dimUpper{0}, dimStride{0}; |
165 | if (j < maxRank && j < source.rank()) { |
166 | const Dimension &dim{source.GetDimension(j)}; |
167 | dimLower = dim.LowerBound(); |
168 | dimUpper = dim.UpperBound(); |
169 | dimStride = |
170 | dim.ByteStride() / std::max<SubscriptValue>(contiguousStride, 1); |
171 | contiguousStride *= dim.Extent(); |
172 | } else if (ok) { |
173 | handler.SignalError( |
174 | "Too many subscripts for rank-%d NAMELIST group item '%s'" , |
175 | source.rank(), name); |
176 | ok = false; |
177 | } |
178 | if (auto low{GetSubscriptValue(io)}) { |
179 | if (*low < dimLower || (dimUpper >= dimLower && *low > dimUpper)) { |
180 | if (ok) { |
181 | handler.SignalError("Subscript %jd out of range %jd..%jd in NAMELIST " |
182 | "group item '%s' dimension %d" , |
183 | static_cast<std::intmax_t>(*low), |
184 | static_cast<std::intmax_t>(dimLower), |
185 | static_cast<std::intmax_t>(dimUpper), name, j + 1); |
186 | ok = false; |
187 | } |
188 | } else { |
189 | dimLower = *low; |
190 | } |
191 | ch = io.GetNextNonBlank(byteCount); |
192 | } |
193 | if (ch && *ch == ':') { |
194 | io.HandleRelativePosition(byteOffset: byteCount); |
195 | ch = io.GetNextNonBlank(byteCount); |
196 | if (auto high{GetSubscriptValue(io)}) { |
197 | if (*high > dimUpper) { |
198 | if (ok) { |
199 | handler.SignalError( |
200 | "Subscript triplet upper bound %jd out of range (>%jd) in " |
201 | "NAMELIST group item '%s' dimension %d" , |
202 | static_cast<std::intmax_t>(*high), |
203 | static_cast<std::intmax_t>(dimUpper), name, j + 1); |
204 | ok = false; |
205 | } |
206 | } else { |
207 | dimUpper = *high; |
208 | } |
209 | ch = io.GetNextNonBlank(byteCount); |
210 | } |
211 | if (ch && *ch == ':') { |
212 | io.HandleRelativePosition(byteOffset: byteCount); |
213 | ch = io.GetNextNonBlank(byteCount); |
214 | if (auto str{GetSubscriptValue(io)}) { |
215 | dimStride = *str; |
216 | ch = io.GetNextNonBlank(byteCount); |
217 | } |
218 | } |
219 | } else { // scalar |
220 | dimUpper = dimLower; |
221 | dimStride = 0; |
222 | } |
223 | if (ch && *ch == comma) { |
224 | io.HandleRelativePosition(byteOffset: byteCount); |
225 | ch = io.GetNextNonBlank(byteCount); |
226 | } |
227 | if (ok) { |
228 | lower[j] = dimLower; |
229 | upper[j] = dimUpper; |
230 | stride[j] = dimStride; |
231 | } |
232 | } |
233 | if (ok) { |
234 | if (ch && *ch == ')') { |
235 | io.HandleRelativePosition(byteOffset: byteCount); |
236 | if (desc.EstablishPointerSection(source, lower, upper, stride)) { |
237 | return true; |
238 | } else { |
239 | handler.SignalError( |
240 | msg: "Bad subscripts for NAMELIST input group item '%s'" , xs&: name); |
241 | } |
242 | } else { |
243 | handler.SignalError( |
244 | msg: "Bad subscripts (missing ')') for NAMELIST input group item '%s'" , |
245 | xs&: name); |
246 | } |
247 | } |
248 | return false; |
249 | } |
250 | |
251 | static void StorageSequenceExtension( |
252 | Descriptor &desc, const Descriptor &source) { |
253 | // Support the near-universal extension of NAMELIST input into a |
254 | // designatable storage sequence identified by its initial scalar array |
255 | // element. For example, treat "A(1) = 1. 2. 3." as if it had been |
256 | // "A(1:) = 1. 2. 3.". |
257 | if (desc.rank() == 0 && (source.rank() == 1 || source.IsContiguous())) { |
258 | if (auto stride{source.rank() == 1 |
259 | ? source.GetDimension(0).ByteStride() |
260 | : static_cast<SubscriptValue>(source.ElementBytes())}; |
261 | stride != 0) { |
262 | desc.raw().attribute = CFI_attribute_pointer; |
263 | desc.raw().rank = 1; |
264 | desc.GetDimension(0) |
265 | .SetBounds(1, |
266 | source.Elements() - |
267 | ((source.OffsetElement() - desc.OffsetElement()) / stride)) |
268 | .SetByteStride(stride); |
269 | } |
270 | } |
271 | } |
272 | |
273 | static bool HandleSubstring( |
274 | IoStatementState &io, Descriptor &desc, const char *name) { |
275 | IoErrorHandler &handler{io.GetIoErrorHandler()}; |
276 | auto pair{desc.type().GetCategoryAndKind()}; |
277 | if (!pair || pair->first != TypeCategory::Character) { |
278 | handler.SignalError(msg: "Substring reference to non-character item '%s'" , xs&: name); |
279 | return false; |
280 | } |
281 | int kind{pair->second}; |
282 | SubscriptValue chars{static_cast<SubscriptValue>(desc.ElementBytes()) / kind}; |
283 | // Allow for blanks in substring bounds; they're nonstandard, but not |
284 | // ambiguous within the parentheses. |
285 | std::optional<SubscriptValue> lower, upper; |
286 | std::size_t byteCount{0}; |
287 | std::optional<char32_t> ch{io.GetNextNonBlank(byteCount)}; |
288 | if (ch) { |
289 | if (*ch == ':') { |
290 | lower = 1; |
291 | } else { |
292 | lower = GetSubscriptValue(io); |
293 | ch = io.GetNextNonBlank(byteCount); |
294 | } |
295 | } |
296 | if (ch && ch == ':') { |
297 | io.HandleRelativePosition(byteOffset: byteCount); |
298 | ch = io.GetNextNonBlank(byteCount); |
299 | if (ch) { |
300 | if (*ch == ')') { |
301 | upper = chars; |
302 | } else { |
303 | upper = GetSubscriptValue(io); |
304 | ch = io.GetNextNonBlank(byteCount); |
305 | } |
306 | } |
307 | } |
308 | if (ch && *ch == ')') { |
309 | io.HandleRelativePosition(byteOffset: byteCount); |
310 | if (lower && upper) { |
311 | if (*lower > *upper) { |
312 | // An empty substring, whatever the values are |
313 | desc.raw().elem_len = 0; |
314 | return true; |
315 | } |
316 | if (*lower >= 1 && *upper <= chars) { |
317 | // Offset the base address & adjust the element byte length |
318 | desc.raw().elem_len = (*upper - *lower + 1) * kind; |
319 | desc.set_base_addr(reinterpret_cast<void *>( |
320 | reinterpret_cast<char *>(desc.raw().base_addr) + |
321 | kind * (*lower - 1))); |
322 | return true; |
323 | } |
324 | } |
325 | handler.SignalError( |
326 | msg: "Bad substring bounds for NAMELIST input group item '%s'" , xs&: name); |
327 | } else { |
328 | handler.SignalError( |
329 | msg: "Bad substring (missing ')') for NAMELIST input group item '%s'" , xs&: name); |
330 | } |
331 | return false; |
332 | } |
333 | |
334 | static bool HandleComponent(IoStatementState &io, Descriptor &desc, |
335 | const Descriptor &source, const char *name) { |
336 | IoErrorHandler &handler{io.GetIoErrorHandler()}; |
337 | char compName[nameBufferSize]; |
338 | if (GetLowerCaseName(io, buffer: compName, maxLength: sizeof compName)) { |
339 | const DescriptorAddendum *addendum{source.Addendum()}; |
340 | if (const typeInfo::DerivedType * |
341 | type{addendum ? addendum->derivedType() : nullptr}) { |
342 | if (const typeInfo::Component * |
343 | comp{type->FindDataComponent(compName, std::strlen(s: compName))}) { |
344 | bool createdDesc{false}; |
345 | if (comp->rank() > 0 && source.rank() > 0) { |
346 | // If base and component are both arrays, the component name |
347 | // must be followed by subscripts; process them now. |
348 | std::size_t byteCount{0}; |
349 | if (std::optional<char32_t> next{io.GetNextNonBlank(byteCount)}; |
350 | next && *next == '(') { |
351 | io.HandleRelativePosition(byteOffset: byteCount); // skip over '(' |
352 | StaticDescriptor<maxRank, true, 16> staticDesc; |
353 | Descriptor &tmpDesc{staticDesc.descriptor()}; |
354 | comp->CreatePointerDescriptor(tmpDesc, source, handler); |
355 | if (!HandleSubscripts(io, desc, source: tmpDesc, name: compName)) { |
356 | return false; |
357 | } |
358 | createdDesc = true; |
359 | } |
360 | } |
361 | if (!createdDesc) { |
362 | comp->CreatePointerDescriptor(desc, source, handler); |
363 | } |
364 | if (source.rank() > 0) { |
365 | if (desc.rank() > 0) { |
366 | handler.SignalError( |
367 | msg: "NAMELIST component reference '%%%s' of input group " |
368 | "item %s cannot be an array when its base is not scalar" , |
369 | xs&: compName, xs&: name); |
370 | return false; |
371 | } |
372 | desc.raw().rank = source.rank(); |
373 | for (int j{0}; j < source.rank(); ++j) { |
374 | const auto &srcDim{source.GetDimension(j)}; |
375 | desc.GetDimension(j) |
376 | .SetBounds(1, srcDim.UpperBound()) |
377 | .SetByteStride(srcDim.ByteStride()); |
378 | } |
379 | } |
380 | return true; |
381 | } else { |
382 | handler.SignalError( |
383 | msg: "NAMELIST component reference '%%%s' of input group item %s is not " |
384 | "a component of its derived type" , |
385 | xs&: compName, xs&: name); |
386 | } |
387 | } else if (source.type().IsDerived()) { |
388 | handler.Crash("Derived type object '%s' in NAMELIST is missing its " |
389 | "derived type information!" , |
390 | name); |
391 | } else { |
392 | handler.SignalError(msg: "NAMELIST component reference '%%%s' of input group " |
393 | "item %s for non-derived type" , |
394 | xs&: compName, xs&: name); |
395 | } |
396 | } else { |
397 | handler.SignalError(msg: "NAMELIST component reference of input group item %s " |
398 | "has no name after '%%'" , |
399 | xs&: name); |
400 | } |
401 | return false; |
402 | } |
403 | |
404 | // Advance to the terminal '/' of a namelist group or leading '&'/'$' |
405 | // of the next. |
406 | static void SkipNamelistGroup(IoStatementState &io) { |
407 | std::size_t byteCount{0}; |
408 | while (auto ch{io.GetNextNonBlank(byteCount)}) { |
409 | io.HandleRelativePosition(byteOffset: byteCount); |
410 | if (*ch == '/' || *ch == '&' || *ch == '$') { |
411 | break; |
412 | } else if (*ch == '\'' || *ch == '"') { |
413 | // Skip quoted character literal |
414 | char32_t quote{*ch}; |
415 | while (true) { |
416 | if ((ch = io.GetCurrentChar(byteCount))) { |
417 | io.HandleRelativePosition(byteOffset: byteCount); |
418 | if (*ch == quote) { |
419 | break; |
420 | } |
421 | } else if (!io.AdvanceRecord()) { |
422 | return; |
423 | } |
424 | } |
425 | } |
426 | } |
427 | } |
428 | |
429 | bool IONAME(InputNamelist)(Cookie cookie, const NamelistGroup &group) { |
430 | IoStatementState &io{*cookie}; |
431 | io.CheckFormattedStmtType<Direction::Input>(name: "InputNamelist" ); |
432 | io.mutableModes().inNamelist = true; |
433 | IoErrorHandler &handler{io.GetIoErrorHandler()}; |
434 | auto *listInput{io.get_if<ListDirectedStatementState<Direction::Input>>()}; |
435 | RUNTIME_CHECK(handler, listInput != nullptr); |
436 | // Find this namelist group's header in the input |
437 | io.BeginReadingRecord(); |
438 | std::optional<char32_t> next; |
439 | char name[nameBufferSize]; |
440 | RUNTIME_CHECK(handler, group.groupName != nullptr); |
441 | char32_t comma{GetComma(io)}; |
442 | std::size_t byteCount{0}; |
443 | while (true) { |
444 | next = io.GetNextNonBlank(byteCount); |
445 | while (next && *next != '&' && *next != '$') { |
446 | // Extension: comment lines without ! before namelist groups |
447 | if (!io.AdvanceRecord()) { |
448 | next.reset(); |
449 | } else { |
450 | next = io.GetNextNonBlank(byteCount); |
451 | } |
452 | } |
453 | if (!next) { |
454 | handler.SignalEnd(); |
455 | return false; |
456 | } |
457 | if (*next != '&' && *next != '$') { |
458 | handler.SignalError( |
459 | msg: "NAMELIST input group does not begin with '&' or '$' (at '%lc')" , |
460 | xs&: *next); |
461 | return false; |
462 | } |
463 | io.HandleRelativePosition(byteOffset: byteCount); |
464 | if (!GetLowerCaseName(io, buffer: name, maxLength: sizeof name)) { |
465 | handler.SignalError(msg: "NAMELIST input group has no name" ); |
466 | return false; |
467 | } |
468 | if (std::strcmp(group.groupName, name) == 0) { |
469 | break; // found it |
470 | } |
471 | SkipNamelistGroup(io); |
472 | } |
473 | // Read the group's items |
474 | while (true) { |
475 | next = io.GetNextNonBlank(byteCount); |
476 | if (!next || *next == '/' || *next == '&' || *next == '$') { |
477 | break; |
478 | } |
479 | if (!GetLowerCaseName(io, buffer: name, maxLength: sizeof name)) { |
480 | handler.SignalError( |
481 | "NAMELIST input group '%s' was not terminated at '%c'" , |
482 | group.groupName, static_cast<char>(*next)); |
483 | return false; |
484 | } |
485 | std::size_t itemIndex{0}; |
486 | for (; itemIndex < group.items; ++itemIndex) { |
487 | if (std::strcmp(name, group.item[itemIndex].name) == 0) { |
488 | break; |
489 | } |
490 | } |
491 | if (itemIndex >= group.items) { |
492 | handler.SignalError( |
493 | "'%s' is not an item in NAMELIST group '%s'" , name, group.groupName); |
494 | return false; |
495 | } |
496 | // Handle indexing and components, if any. No spaces are allowed. |
497 | // A copy of the descriptor is made if necessary. |
498 | const Descriptor &itemDescriptor{group.item[itemIndex].descriptor}; |
499 | const Descriptor *useDescriptor{&itemDescriptor}; |
500 | StaticDescriptor<maxRank, true, 16> staticDesc[2]; |
501 | int whichStaticDesc{0}; |
502 | next = io.GetCurrentChar(byteCount); |
503 | bool hadSubscripts{false}; |
504 | bool hadSubstring{false}; |
505 | if (next && (*next == '(' || *next == '%')) { |
506 | const Descriptor *lastSubscriptBase{nullptr}; |
507 | Descriptor *lastSubscriptDescriptor{nullptr}; |
508 | do { |
509 | Descriptor &mutableDescriptor{staticDesc[whichStaticDesc].descriptor()}; |
510 | whichStaticDesc ^= 1; |
511 | io.HandleRelativePosition(byteOffset: byteCount); // skip over '(' or '%' |
512 | lastSubscriptDescriptor = nullptr; |
513 | lastSubscriptBase = nullptr; |
514 | if (*next == '(') { |
515 | if (!hadSubstring && (hadSubscripts || useDescriptor->rank() == 0)) { |
516 | mutableDescriptor = *useDescriptor; |
517 | mutableDescriptor.raw().attribute = CFI_attribute_pointer; |
518 | if (!HandleSubstring(io, desc&: mutableDescriptor, name)) { |
519 | return false; |
520 | } |
521 | hadSubstring = true; |
522 | } else if (hadSubscripts) { |
523 | handler.SignalError("Multiple sets of subscripts for item '%s' in " |
524 | "NAMELIST group '%s'" , |
525 | name, group.groupName); |
526 | return false; |
527 | } else if (HandleSubscripts( |
528 | io, desc&: mutableDescriptor, source: *useDescriptor, name)) { |
529 | lastSubscriptBase = useDescriptor; |
530 | lastSubscriptDescriptor = &mutableDescriptor; |
531 | } else { |
532 | return false; |
533 | } |
534 | hadSubscripts = true; |
535 | } else { |
536 | if (!HandleComponent(io, desc&: mutableDescriptor, source: *useDescriptor, name)) { |
537 | return false; |
538 | } |
539 | hadSubscripts = false; |
540 | hadSubstring = false; |
541 | } |
542 | useDescriptor = &mutableDescriptor; |
543 | next = io.GetCurrentChar(byteCount); |
544 | } while (next && (*next == '(' || *next == '%')); |
545 | if (lastSubscriptDescriptor) { |
546 | StorageSequenceExtension(desc&: *lastSubscriptDescriptor, source: *lastSubscriptBase); |
547 | } |
548 | } |
549 | // Skip the '=' |
550 | next = io.GetNextNonBlank(byteCount); |
551 | if (!next || *next != '=') { |
552 | handler.SignalError("No '=' found after item '%s' in NAMELIST group '%s'" , |
553 | name, group.groupName); |
554 | return false; |
555 | } |
556 | io.HandleRelativePosition(byteOffset: byteCount); |
557 | // Read the values into the descriptor. An array can be short. |
558 | if (const auto *addendum{useDescriptor->Addendum()}; |
559 | addendum && addendum->derivedType()) { |
560 | const NonTbpDefinedIoTable *table{group.nonTbpDefinedIo}; |
561 | listInput->ResetForNextNamelistItem(/*inNamelistSequence=*/true); |
562 | if (!IONAME(InputDerivedType)(cookie, *useDescriptor, table)) { |
563 | return false; |
564 | } |
565 | } else { |
566 | listInput->ResetForNextNamelistItem(inNamelistSequence: useDescriptor->rank() > 0); |
567 | if (!descr::DescriptorIO<Direction::Input>(io, descriptor: *useDescriptor)) { |
568 | return false; |
569 | } |
570 | } |
571 | next = io.GetNextNonBlank(byteCount); |
572 | if (next && *next == comma) { |
573 | io.HandleRelativePosition(byteOffset: byteCount); |
574 | } |
575 | } |
576 | if (next && *next == '/') { |
577 | io.HandleRelativePosition(byteOffset: byteCount); |
578 | } else if (*next && (*next == '&' || *next == '$')) { |
579 | // stop at beginning of next group |
580 | } else { |
581 | handler.SignalError( |
582 | "No '/' found after NAMELIST group '%s'" , group.groupName); |
583 | return false; |
584 | } |
585 | return true; |
586 | } |
587 | |
588 | bool IsNamelistNameOrSlash(IoStatementState &io) { |
589 | if (auto *listInput{ |
590 | io.get_if<ListDirectedStatementState<Direction::Input>>()}) { |
591 | if (listInput->inNamelistSequence()) { |
592 | SavedPosition savedPosition{io}; |
593 | std::size_t byteCount{0}; |
594 | if (auto ch{io.GetNextNonBlank(byteCount)}) { |
595 | if (IsLegalIdStart(ch: *ch)) { |
596 | do { |
597 | io.HandleRelativePosition(byteOffset: byteCount); |
598 | ch = io.GetCurrentChar(byteCount); |
599 | } while (ch && IsLegalIdChar(ch: *ch)); |
600 | ch = io.GetNextNonBlank(byteCount); |
601 | // TODO: how to deal with NaN(...) ambiguity? |
602 | return ch && (*ch == '=' || *ch == '(' || *ch == '%'); |
603 | } else { |
604 | return *ch == '/' || *ch == '&' || *ch == '$'; |
605 | } |
606 | } |
607 | } |
608 | } |
609 | return false; |
610 | } |
611 | |
612 | } // namespace Fortran::runtime::io |
613 | |