maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[flang] Admit trailing blanks when checking I/O specifiers 

Fortran specifically allows character-valued I/O specifiers
to have trailing blanks, e.g. OPEN(666,STATUS='SCRATCH ').
The runtime I/O library already handles them, but the I/O
static checks in semantics do not.

Differential Revision: https://reviews.llvm.org/D130381
This commit is contained in:
Peter Klausler 2022-07-18 11:16:01 -07:00
parent ee6aba85aa
commit c105d9b3d6
2 changed files with 16 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
flang/lib/Semantics/check-io.cpp
View File

@ -97,6 +97,14 @@ void IoChecker::Enter(const parser::ConnectSpec &spec) {
}
}
// Ignore trailing spaces (12.5.6.2 p1) and convert to upper case
static std::string Normalize(const std::string &value) {
auto upper{parser::ToUpperCaseLetters(value)};
std::size_t lastNonBlank{upper.find_last_not_of(" ")};
upper.resize(lastNonBlank == std::string::npos ? 0 : lastNonBlank + 1);
return upper;
}
void IoChecker::Enter(const parser::ConnectSpec::CharExpr &spec) {
IoSpecKind specKind{};
using ParseKind = parser::ConnectSpec::CharExpr::Kind;
@ -150,7 +158,7 @@ void IoChecker::Enter(const parser::ConnectSpec::CharExpr &spec) {
SetSpecifier(specKind);
if (const std::optional<std::string> charConst{GetConstExpr<std::string>(
std::get<parser::ScalarDefaultCharExpr>(spec.t))}) {
std::string s{parser::ToUpperCaseLetters(*charConst)};
std::string s{Normalize(*charConst)};
if (specKind == IoSpecKind::Access) {
flags_.set(Flag::KnownAccess);
flags_.set(Flag::AccessDirect, s == "DIRECT");
@ -484,8 +492,7 @@ void IoChecker::Enter(const parser::IoControlSpec::Asynchronous &spec) {
SetSpecifier(IoSpecKind::Asynchronous);
if (const std::optional<std::string> charConst{
GetConstExpr<std::string>(spec)}) {
flags_.set(
Flag::AsynchronousYes, parser::ToUpperCaseLetters(*charConst) == "YES");
flags_.set(Flag::AsynchronousYes, Normalize(*charConst) == "YES");
CheckStringValue(IoSpecKind::Asynchronous, *charConst,
parser::FindSourceLocation(spec)); // C1223
}
@ -521,8 +528,7 @@ void IoChecker::Enter(const parser::IoControlSpec::CharExpr &spec) {
if (const std::optional<std::string> charConst{GetConstExpr<std::string>(
std::get<parser::ScalarDefaultCharExpr>(spec.t))}) {
if (specKind == IoSpecKind::Advance) {
flags_.set(
Flag::AdvanceYes, parser::ToUpperCaseLetters(*charConst) == "YES");
flags_.set(Flag::AdvanceYes, Normalize(*charConst) == "YES");
}
CheckStringValue(specKind, *charConst, parser::FindSourceLocation(spec));
}
@ -601,7 +607,7 @@ void IoChecker::Enter(const parser::StatusExpr &spec) {
if (const std::optional<std::string> charConst{
GetConstExpr<std::string>(spec)}) {
// Status values for Open and Close are different.
std::string s{parser::ToUpperCaseLetters(*charConst)};
std::string s{Normalize(*charConst)};
if (stmt_ == IoStmtKind::Open) {
flags_.set(Flag::KnownStatus);
flags_.set(Flag::StatusNew, s == "NEW");
@ -868,7 +874,7 @@ void IoChecker::CheckStringValue(IoSpecKind specKind, const std::string &value,
{IoSpecKind::Convert, {"BIG_ENDIAN", "LITTLE_ENDIAN", "NATIVE"}},
{IoSpecKind::Dispose, {"DELETE", "KEEP"}},
};
auto upper{parser::ToUpperCaseLetters(value)};
auto upper{Normalize(value)};
if (specValues.at(specKind).count(upper) == 0) {
if (specKind == IoSpecKind::Access && upper == "APPEND") {
if (context_.languageFeatures().ShouldWarn(

3
flang/test/Semantics/io02.f90
View File

@ -29,6 +29,9 @@
!ERROR: Invalid STATUS value 'old'
close(status='old', unit=17)
!Ok: trailing spaces ignored
close(status='keep ', unit=17)
!ERROR: IOSTAT variable 'const_stat' must be definable
close(14, iostat=const_stat)