diff --git a/flang/runtime/namelist.cpp b/flang/runtime/namelist.cpp --- a/flang/runtime/namelist.cpp +++ b/flang/runtime/namelist.cpp @@ -225,6 +225,67 @@ 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::optional ch{io.GetNextNonBlank()}; + if (ch) { + if (*ch == ':') { + lower = 1; + } else { + lower = GetSubscriptValue(io); + ch = io.GetNextNonBlank(); + } + } + if (ch && ch == ':') { + io.HandleRelativePosition(1); + ch = io.GetNextNonBlank(); + if (ch) { + if (*ch == ')') { + upper = chars; + } else { + upper = GetSubscriptValue(io); + ch = io.GetNextNonBlank(); + } + } + } + if (ch && *ch == ')') { + io.HandleRelativePosition(1); + 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()}; @@ -319,19 +380,36 @@ StaticDescriptor staticDesc[2]; int whichStaticDesc{0}; next = io.GetCurrentChar(); + bool hadSubscripts{false}; + bool hadSubstring{false}; if (next && (*next == '(' || *next == '%')) { do { Descriptor &mutableDescriptor{staticDesc[whichStaticDesc].descriptor()}; whichStaticDesc ^= 1; if (*next == '(') { - if (!(HandleSubscripts( - io, mutableDescriptor, *useDescriptor, name))) { + 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(); diff --git a/flang/unittests/Runtime/Namelist.cpp b/flang/unittests/Runtime/Namelist.cpp --- a/flang/unittests/Runtime/Namelist.cpp +++ b/flang/unittests/Runtime/Namelist.cpp @@ -136,8 +136,8 @@ const NamelistGroup::Item items[]{{"a", *aDesc}}; const NamelistGroup group{"justa", 1, items}; static char t1[]{"&justa A(0,1:-1:-2)=1 2/"}; - StaticDescriptor<1, true> statDescs[2]; - Descriptor &internalDesc{statDescs[0].descriptor()}; + StaticDescriptor<1, true> statDesc; + Descriptor &internalDesc{statDesc.descriptor()}; internalDesc.Establish(TypeCode{CFI_type_char}, /*elementBytes=*/std::strlen(t1), t1, 0, nullptr, CFI_attribute_pointer); auto inCookie{IONAME(BeginInternalArrayListInput)( @@ -189,4 +189,61 @@ EXPECT_EQ(*bDesc->ZeroBasedIndexedElement(1), -2); } +TEST(NamelistTypes, ScalarSubstring) { + OwningPtr scDesc{MakeArray( + std::vector{}, std::vector{"abcdefgh"}, 8)}; + const NamelistGroup::Item items[]{{"a", *scDesc}}; + const NamelistGroup group{"justa", 1, items}; + static char t1[]{"&justa A(2:5)='BCDE'/"}; + StaticDescriptor<1, true> statDesc; + Descriptor &internalDesc{statDesc.descriptor()}; + internalDesc.Establish(TypeCode{CFI_type_char}, + /*elementBytes=*/std::strlen(t1), t1, 0, nullptr, CFI_attribute_pointer); + auto inCookie{IONAME(BeginInternalArrayListInput)( + internalDesc, nullptr, 0, __FILE__, __LINE__)}; + ASSERT_TRUE(IONAME(InputNamelist)(inCookie, group)); + ASSERT_EQ(IONAME(EndIoStatement)(inCookie), IostatOk) + << "namelist scalar substring input"; + char out[32]; + internalDesc.Establish(TypeCode{CFI_type_char}, /*elementBytes=*/sizeof out, + out, 0, nullptr, CFI_attribute_pointer); + auto outCookie{IONAME(BeginInternalArrayListOutput)( + internalDesc, nullptr, 0, __FILE__, __LINE__)}; + ASSERT_TRUE(IONAME(SetDelim)(outCookie, "apostrophe", 10)); + ASSERT_TRUE(IONAME(OutputNamelist)(outCookie, group)); + ASSERT_EQ(IONAME(EndIoStatement)(outCookie), IostatOk) << "namelist output"; + std::string got{out, sizeof out}; + static const std::string expect{"&JUSTA A= 'aBCDEfgh'/ "}; + EXPECT_EQ(got, expect); +} + +TEST(NamelistTypes, ArraySubstring) { + OwningPtr scDesc{ + MakeArray(std::vector{2}, + std::vector{"abcdefgh", "ijklmnop"}, 8)}; + const NamelistGroup::Item items[]{{"a", *scDesc}}; + const NamelistGroup group{"justa", 1, items}; + static char t1[]{"&justa A(:)(2:5)='BCDE' 'JKLM'/"}; + StaticDescriptor<1, true> statDesc; + Descriptor &internalDesc{statDesc.descriptor()}; + internalDesc.Establish(TypeCode{CFI_type_char}, + /*elementBytes=*/std::strlen(t1), t1, 0, nullptr, CFI_attribute_pointer); + auto inCookie{IONAME(BeginInternalArrayListInput)( + internalDesc, nullptr, 0, __FILE__, __LINE__)}; + ASSERT_TRUE(IONAME(InputNamelist)(inCookie, group)); + ASSERT_EQ(IONAME(EndIoStatement)(inCookie), IostatOk) + << "namelist scalar substring input"; + char out[40]; + internalDesc.Establish(TypeCode{CFI_type_char}, /*elementBytes=*/sizeof out, + out, 0, nullptr, CFI_attribute_pointer); + auto outCookie{IONAME(BeginInternalArrayListOutput)( + internalDesc, nullptr, 0, __FILE__, __LINE__)}; + ASSERT_TRUE(IONAME(SetDelim)(outCookie, "apostrophe", 10)); + ASSERT_TRUE(IONAME(OutputNamelist)(outCookie, group)); + ASSERT_EQ(IONAME(EndIoStatement)(outCookie), IostatOk) << "namelist output"; + std::string got{out, sizeof out}; + static const std::string expect{"&JUSTA A= 'aBCDEfgh' 'iJKLMnop'/ "}; + EXPECT_EQ(got, expect); +} + // TODO: Internal NAMELIST error tests