//===-- runtime/namelist.cpp ----------------------------------------------===// // // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. // See https://llvm.org/LICENSE.txt for license information. // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// #include "namelist.h" #include "descriptor-io.h" #include "io-stmt.h" #include "flang/Runtime/io-api.h" #include #include #include namespace Fortran::runtime::io { // Max size of a group, symbol or component identifier that can appear in // NAMELIST input, plus a byte for NUL termination. static constexpr std::size_t nameBufferSize{201}; static inline char32_t GetComma(IoStatementState &io) { return io.mutableModes().editingFlags & decimalComma ? char32_t{';'} : char32_t{','}; } bool IONAME(OutputNamelist)(Cookie cookie, const NamelistGroup &group) { IoStatementState &io{*cookie}; io.CheckFormattedStmtType("OutputNamelist"); io.mutableModes().inNamelist = true; char comma{static_cast(GetComma(io))}; ConnectionState &connection{io.GetConnectionState()}; // Internal functions to advance records and convert case const auto EmitWithAdvance{[&](char ch) -> bool { return (!connection.NeedAdvance(1) || io.AdvanceRecord()) && io.Emit(&ch, 1); }}; const auto EmitUpperCase{[&](const char *str) -> bool { if (connection.NeedAdvance(std::strlen(str)) && !(io.AdvanceRecord() && io.Emit(" ", 1))) { return false; } for (; *str; ++str) { char up{*str >= 'a' && *str <= 'z' ? static_cast(*str - 'a' + 'A') : *str}; if (!io.Emit(&up, 1)) { return false; } } return true; }}; // &GROUP if (!(EmitWithAdvance('&') && EmitUpperCase(group.groupName))) { return false; } auto *listOutput{io.get_if>()}; for (std::size_t j{0}; j < group.items; ++j) { // [,]ITEM=... const NamelistGroup::Item &item{group.item[j]}; if (listOutput) { listOutput->set_lastWasUndelimitedCharacter(false); } if (!(EmitWithAdvance(j == 0 ? ' ' : comma) && EmitUpperCase(item.name) && EmitWithAdvance('=') && descr::DescriptorIO(io, item.descriptor))) { return false; } } // terminal / return EmitWithAdvance('/'); } static constexpr bool IsLegalIdStart(char32_t ch) { return (ch >= 'A' && ch <= 'Z') || (ch >= 'a' && ch <= 'z') || ch == '_' || ch == '@' || ch == '$'; } static constexpr bool IsLegalIdChar(char32_t ch) { return IsLegalIdStart(ch) || (ch >= '0' && ch <= '9'); } static constexpr char NormalizeIdChar(char32_t ch) { return static_cast(ch >= 'A' && ch <= 'Z' ? ch - 'A' + 'a' : ch); } static bool GetLowerCaseName( IoStatementState &io, char buffer[], std::size_t maxLength) { std::size_t byteLength{0}; if (auto ch{io.GetNextNonBlank(byteLength)}) { if (IsLegalIdStart(*ch)) { std::size_t j{0}; do { buffer[j] = NormalizeIdChar(*ch); io.HandleRelativePosition(byteLength); ch = io.GetCurrentChar(byteLength); } while (++j < maxLength && ch && IsLegalIdChar(*ch)); buffer[j++] = '\0'; if (j <= maxLength) { return true; } io.GetIoErrorHandler().SignalError( "Identifier '%s...' in NAMELIST input group is too long", buffer); } } return false; } static std::optional GetSubscriptValue(IoStatementState &io) { std::optional value; std::size_t byteCount{0}; std::optional ch{io.GetCurrentChar(byteCount)}; bool negate{ch && *ch == '-'}; if ((ch && *ch == '+') || negate) { io.HandleRelativePosition(byteCount); ch = io.GetCurrentChar(byteCount); } bool overflow{false}; while (ch && *ch >= '0' && *ch <= '9') { SubscriptValue was{value.value_or(0)}; overflow |= was >= std::numeric_limits::max() / 10; value = 10 * was + *ch - '0'; io.HandleRelativePosition(byteCount); ch = io.GetCurrentChar(byteCount); } if (overflow) { io.GetIoErrorHandler().SignalError( "NAMELIST input subscript value overflow"); return std::nullopt; } if (negate) { if (value) { return -*value; } else { io.HandleRelativePosition(-byteCount); // give back '-' with no digits } } return value; } static bool HandleSubscripts(IoStatementState &io, Descriptor &desc, const Descriptor &source, const char *name) { IoErrorHandler &handler{io.GetIoErrorHandler()}; io.HandleRelativePosition(1); // skip '(' // Allow for blanks in subscripts; they're nonstandard, but not // ambiguous within the parentheses. SubscriptValue lower[maxRank], upper[maxRank], stride[maxRank]; int j{0}; std::size_t contiguousStride{source.ElementBytes()}; bool ok{true}; std::size_t byteCount{0}; std::optional ch{io.GetNextNonBlank(byteCount)}; char32_t comma{GetComma(io)}; for (; ch && *ch != ')'; ++j) { SubscriptValue dimLower{0}, dimUpper{0}, dimStride{0}; if (j < maxRank && j < source.rank()) { const Dimension &dim{source.GetDimension(j)}; dimLower = dim.LowerBound(); dimUpper = dim.UpperBound(); dimStride = dim.ByteStride() / std::max(contiguousStride, 1); contiguousStride *= dim.Extent(); } else if (ok) { handler.SignalError( "Too many subscripts for rank-%d NAMELIST group item '%s'", source.rank(), name); ok = false; } if (auto low{GetSubscriptValue(io)}) { if (*low < dimLower || (dimUpper >= dimLower && *low > dimUpper)) { if (ok) { handler.SignalError("Subscript %jd out of range %jd..%jd in NAMELIST " "group item '%s' dimension %d", static_cast(*low), static_cast(dimLower), static_cast(dimUpper), name, j + 1); ok = false; } } else { dimLower = *low; } ch = io.GetNextNonBlank(byteCount); } if (ch && *ch == ':') { io.HandleRelativePosition(byteCount); ch = io.GetNextNonBlank(byteCount); if (auto high{GetSubscriptValue(io)}) { if (*high > dimUpper) { if (ok) { handler.SignalError( "Subscript triplet upper bound %jd out of range (>%jd) in " "NAMELIST group item '%s' dimension %d", static_cast(*high), static_cast(dimUpper), name, j + 1); ok = false; } } else { dimUpper = *high; } ch = io.GetNextNonBlank(byteCount); } if (ch && *ch == ':') { io.HandleRelativePosition(byteCount); ch = io.GetNextNonBlank(byteCount); if (auto str{GetSubscriptValue(io)}) { dimStride = *str; ch = io.GetNextNonBlank(byteCount); } } } else { // scalar dimUpper = dimLower; dimStride = 0; } if (ch && *ch == comma) { io.HandleRelativePosition(byteCount); ch = io.GetNextNonBlank(byteCount); } if (ok) { lower[j] = dimLower; upper[j] = dimUpper; stride[j] = dimStride; } } if (ok) { if (ch && *ch == ')') { io.HandleRelativePosition(byteCount); if (desc.EstablishPointerSection(source, lower, upper, stride)) { return true; } else { handler.SignalError( "Bad subscripts for NAMELIST input group item '%s'", name); } } else { handler.SignalError( "Bad subscripts (missing ')') for NAMELIST input group item '%s'", name); } } return false; } static bool HandleSubstring( IoStatementState &io, Descriptor &desc, const char *name) { IoErrorHandler &handler{io.GetIoErrorHandler()}; auto pair{desc.type().GetCategoryAndKind()}; if (!pair || pair->first != TypeCategory::Character) { handler.SignalError("Substring reference to non-character item '%s'", name); return false; } int kind{pair->second}; SubscriptValue chars{static_cast(desc.ElementBytes()) / kind}; // Allow for blanks in substring bounds; they're nonstandard, but not // ambiguous within the parentheses. io.HandleRelativePosition(1); // skip '(' std::optional lower, upper; std::size_t byteCount{0}; std::optional ch{io.GetNextNonBlank(byteCount)}; if (ch) { if (*ch == ':') { lower = 1; } else { lower = GetSubscriptValue(io); ch = io.GetNextNonBlank(byteCount); } } if (ch && ch == ':') { io.HandleRelativePosition(byteCount); ch = io.GetNextNonBlank(byteCount); if (ch) { if (*ch == ')') { upper = chars; } else { upper = GetSubscriptValue(io); ch = io.GetNextNonBlank(byteCount); } } } if (ch && *ch == ')') { io.HandleRelativePosition(byteCount); if (lower && upper) { if (*lower > *upper) { // An empty substring, whatever the values are desc.raw().elem_len = 0; return true; } if (*lower >= 1 || *upper <= chars) { // Offset the base address & adjust the element byte length desc.raw().elem_len = (*upper - *lower + 1) * kind; desc.set_base_addr(reinterpret_cast( reinterpret_cast(desc.raw().base_addr) + kind * (*lower - 1))); return true; } } handler.SignalError( "Bad substring bounds for NAMELIST input group item '%s'", name); } else { handler.SignalError( "Bad substring (missing ')') for NAMELIST input group item '%s'", name); } return false; } static bool HandleComponent(IoStatementState &io, Descriptor &desc, const Descriptor &source, const char *name) { IoErrorHandler &handler{io.GetIoErrorHandler()}; io.HandleRelativePosition(1); // skip '%' char compName[nameBufferSize]; if (GetLowerCaseName(io, compName, sizeof compName)) { const DescriptorAddendum *addendum{source.Addendum()}; if (const typeInfo::DerivedType * type{addendum ? addendum->derivedType() : nullptr}) { if (const typeInfo::Component * comp{type->FindDataComponent(compName, std::strlen(compName))}) { comp->CreatePointerDescriptor(desc, source, handler); return true; } else { handler.SignalError( "NAMELIST component reference '%%%s' of input group item %s is not " "a component of its derived type", compName, name); } } else if (source.type().IsDerived()) { handler.Crash("Derived type object '%s' in NAMELIST is missing its " "derived type information!", name); } else { handler.SignalError("NAMELIST component reference '%%%s' of input group " "item %s for non-derived type", compName, name); } } else { handler.SignalError("NAMELIST component reference of input group item %s " "has no name after '%'", name); } return false; } // Advance to the terminal '/' of a namelist group. static void SkipNamelistGroup(IoStatementState &io) { std::size_t byteCount{0}; while (auto ch{io.GetNextNonBlank(byteCount)}) { io.HandleRelativePosition(byteCount); if (*ch == '/') { break; } else if (*ch == '\'' || *ch == '"') { // Skip quoted character literal char32_t quote{*ch}; while (true) { if ((ch = io.GetCurrentChar(byteCount))) { io.HandleRelativePosition(byteCount); if (*ch == quote) { break; } } else if (!io.AdvanceRecord()) { return; } } } } } bool IONAME(InputNamelist)(Cookie cookie, const NamelistGroup &group) { IoStatementState &io{*cookie}; io.CheckFormattedStmtType("InputNamelist"); io.mutableModes().inNamelist = true; IoErrorHandler &handler{io.GetIoErrorHandler()}; auto *listInput{io.get_if>()}; RUNTIME_CHECK(handler, listInput != nullptr); // Find this namelist group's header in the input io.BeginReadingRecord(); std::optional next; char name[nameBufferSize]; RUNTIME_CHECK(handler, group.groupName != nullptr); char32_t comma{GetComma(io)}; std::size_t byteCount{0}; while (true) { next = io.GetNextNonBlank(byteCount); while (next && *next != '&') { // Extension: comment lines without ! before namelist groups if (!io.AdvanceRecord()) { next.reset(); } else { next = io.GetNextNonBlank(byteCount); } } if (!next || *next != '&') { handler.SignalError( "NAMELIST input group does not begin with '&' (at '%lc')", *next); return false; } io.HandleRelativePosition(byteCount); if (!GetLowerCaseName(io, name, sizeof name)) { handler.SignalError("NAMELIST input group has no name"); return false; } if (std::strcmp(group.groupName, name) == 0) { break; // found it } SkipNamelistGroup(io); } // Read the group's items while (true) { next = io.GetNextNonBlank(byteCount); if (!next || *next == '/') { break; } if (!GetLowerCaseName(io, name, sizeof name)) { handler.SignalError( "NAMELIST input group '%s' was not terminated at '%c'", group.groupName, static_cast(*next)); return false; } std::size_t itemIndex{0}; for (; itemIndex < group.items; ++itemIndex) { if (std::strcmp(name, group.item[itemIndex].name) == 0) { break; } } if (itemIndex >= group.items) { handler.SignalError( "'%s' is not an item in NAMELIST group '%s'", name, group.groupName); return false; } // Handle indexing and components, if any. No spaces are allowed. // A copy of the descriptor is made if necessary. const Descriptor &itemDescriptor{group.item[itemIndex].descriptor}; const Descriptor *useDescriptor{&itemDescriptor}; StaticDescriptor staticDesc[2]; int whichStaticDesc{0}; next = io.GetCurrentChar(byteCount); bool hadSubscripts{false}; bool hadSubstring{false}; if (next && (*next == '(' || *next == '%')) { do { Descriptor &mutableDescriptor{staticDesc[whichStaticDesc].descriptor()}; whichStaticDesc ^= 1; if (*next == '(') { if (!hadSubstring && (hadSubscripts || useDescriptor->rank() == 0)) { mutableDescriptor = *useDescriptor; mutableDescriptor.raw().attribute = CFI_attribute_pointer; if (!HandleSubstring(io, mutableDescriptor, name)) { return false; } hadSubstring = true; } else if (hadSubscripts) { handler.SignalError("Multiple sets of subscripts for item '%s' in " "NAMELIST group '%s'", name, group.groupName); return false; } else if (!HandleSubscripts( io, mutableDescriptor, *useDescriptor, name)) { return false; } hadSubscripts = true; } else { if (!HandleComponent(io, mutableDescriptor, *useDescriptor, name)) { return false; } hadSubscripts = false; hadSubstring = false; } useDescriptor = &mutableDescriptor; next = io.GetCurrentChar(byteCount); } while (next && (*next == '(' || *next == '%')); } // Skip the '=' next = io.GetNextNonBlank(byteCount); if (!next || *next != '=') { handler.SignalError("No '=' found after item '%s' in NAMELIST group '%s'", name, group.groupName); return false; } io.HandleRelativePosition(byteCount); // Read the values into the descriptor. An array can be short. listInput->ResetForNextNamelistItem(); if (!descr::DescriptorIO(io, *useDescriptor)) { return false; } next = io.GetNextNonBlank(byteCount); if (next && *next == comma) { io.HandleRelativePosition(byteCount); } } if (!next || *next != '/') { handler.SignalError( "No '/' found after NAMELIST group '%s'", group.groupName); return false; } io.HandleRelativePosition(1); return true; } bool IsNamelistName(IoStatementState &io) { if (io.get_if>()) { if (io.mutableModes().inNamelist) { SavedPosition savedPosition{io}; std::size_t byteCount{0}; if (auto ch{io.GetNextNonBlank(byteCount)}) { if (IsLegalIdStart(*ch)) { do { io.HandleRelativePosition(byteCount); ch = io.GetCurrentChar(byteCount); } while (ch && IsLegalIdChar(*ch)); ch = io.GetNextNonBlank(byteCount); // TODO: how to deal with NaN(...) ambiguity? return ch && (*ch == '=' || *ch == '(' || *ch == '%'); } } } } return false; } } // namespace Fortran::runtime::io