squiid/llvm
1
0
Fork 0
Code Issues Pull requests Activity

[flang] Support substring references in NAMELIST input

Browse source 
Implements substring references into potentially partial CHARACTER
scalars and array elements in NAMELIST input.

Differential Revision: https://reviews.llvm.org/D117576
This commit is contained in:
Peter Klausler 2022-01-07 13:39:28 -08:00
parent 1dbe32dd9c
commit 0ab170803f
2 changed files with 139 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

82
flang/runtime/namelist.cpp
View file

@ -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()};
@ -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();

61
flang/unittests/Runtime/Namelist.cpp
View file

@ -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)(
@ -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