Skip to content

Commit

Permalink
[flang] Support substring references in NAMELIST input
Browse files Browse the repository at this point in the history 
Implements substring references into potentially partial CHARACTER
scalars and array elements in NAMELIST input.

Differential Revision: https://reviews.llvm.org/D117576
  • Loading branch information
@klausler
klausler committed Jan 18, 2022
1 parent 1dbe32d commit 0ab1708
Show file tree
Hide file tree
Showing 2 changed files with 139 additions and 4 deletions.
82 changes: 80 additions & 2 deletions flang/runtime/namelist.cpp
View file
Expand Up @@ -225,6 +225,67 @@ static bool HandleSubscripts(IoStatementState &io, Descriptor &desc,
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<SubscriptValue>(desc.ElementBytes()) / kind};
// Allow for blanks in substring bounds; they're nonstandard, but not
// ambiguous within the parentheses.
io.HandleRelativePosition(1); // skip '('
std::optional<SubscriptValue> lower, upper;
std::optional<char32_t> 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<void *>(
reinterpret_cast<char *>(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()};
Expand Down Expand Up @@ -319,19 +380,36 @@ bool IONAME(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
StaticDescriptor<maxRank, true, 16> 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();
Expand Down
61 changes: 59 additions & 2 deletions flang/unittests/Runtime/Namelist.cpp
View file
Expand Up @@ -136,8 +136,8 @@ TEST(NamelistTests, Subscripts) {
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)(
Expand Down Expand Up @@ -189,4 +189,61 @@ TEST(NamelistTests, ShortArrayInput) {
EXPECT_EQ(*bDesc->ZeroBasedIndexedElement<int>(1), -2);
}

TEST(NamelistTypes, ScalarSubstring) {
OwningPtr<Descriptor> scDesc{MakeArray<TypeCategory::Character, 1>(
std::vector<int>{}, std::vector<std::string>{"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<Descriptor> scDesc{
MakeArray<TypeCategory::Character, 1>(std::vector<int>{2},
std::vector<std::string>{"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

0 comments on commit 0ab1708

Please sign in to comment.