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