flang/runtime/namelist.cpp

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