[flang] Roll up fixes for semantic analysis of SPEC CPU codes

- Add cases to IsDescriptor
- Fix NULLIFY in PURE checking
- Fix fotonik3d mutually-referencing derived type bug
- Fix spurious I/O error message on ALLOCATE

Original-commit: flang-compiler/f18@34b64db7da
Reviewed-on: https://github.com/flang-compiler/f18/pull/883
This commit is contained in:
peter klausler 2019-12-18 17:06:13 -08:00
parent 2e9633125e
commit 617a4cce50
13 changed files with 125 additions and 71 deletions

View File

@ -2130,6 +2130,9 @@ Expr<TO> FoldOperation(
Operand::category == TypeCategory::Logical) {
return Expr<TO>{value->IsTrue()};
}
} else if constexpr (std::is_same_v<Operand, TO> &&
FROMCAT != TypeCategory::Character) {
return std::move(kindExpr); // remove needless conversion
}
return Expr<TO>{std::move(convert)};
},
@ -2143,8 +2146,12 @@ Expr<T> FoldOperation(FoldingContext &context, Parentheses<T> &&x) {
if (auto value{GetScalarConstantValue<T>(operand)}) {
// Preserve parentheses, even around constants.
return Expr<T>{Parentheses<T>{Expr<T>{Constant<T>{*value}}}};
} else if (std::holds_alternative<Parentheses<T>>(operand.u)) {
// ((x)) -> (x)
return std::move(operand);
} else {
return Expr<T>{Parentheses<T>{std::move(operand)}};
}
return Expr<T>{Parentheses<T>{std::move(operand)}};
}
template<typename T>

View File

@ -226,6 +226,10 @@ template<typename T> static Precedence ToPrecedence(const Constant<T> &x) {
template<typename T> constexpr Precedence ToPrecedence(const Parentheses<T> &) {
return Precedence::Parenthesize;
}
template<int KIND>
constexpr Precedence ToPrecedence(const ComplexConstructor<KIND> &) {
return Precedence::Parenthesize;
}
template<typename T> static Precedence ToPrecedence(const Expr<T> &expr) {
return std::visit([](const auto &x) { return ToPrecedence(x); }, expr.u);
@ -260,7 +264,25 @@ constexpr OperatorSpelling SpellOperator(const Negate<A> &) {
}
template<int KIND>
static OperatorSpelling SpellOperator(const ComplexComponent<KIND> &x) {
return OperatorSpelling{x.isImaginaryPart ? "AIMAG(" : "REAL(", "", ")"};
if (x.isImaginaryPart) {
return {"aimag(", "", ")"};
} else if constexpr (KIND == 2) {
return {"real(", "", ",kind=2)"};
} else if constexpr (KIND == 3) {
return {"real(", "", ",kind=3)"};
} else if constexpr (KIND == 4) {
return {"real(", "", ",kind=4)"};
} else if constexpr (KIND == 8) {
return {"real(", "", ",kind=8)"};
} else if constexpr (KIND == 10) {
return {"real(", "", ",kind=10)"};
} else if constexpr (KIND == 16) {
return {"real(", "", ",kind=16)"};
} else {
static_assert(KIND == 2 || KIND == 3 || KIND == 4 || KIND == 8 ||
KIND == 10 || KIND == 16,
"bad KIND");
}
}
template<int KIND> constexpr OperatorSpelling SpellOperator(const Not<KIND> &) {
return OperatorSpelling{".NOT.", "", ""};
@ -299,7 +321,7 @@ constexpr OperatorSpelling SpellOperator(const RealToIntPower<A> &) {
template<typename A>
static OperatorSpelling SpellOperator(const Extremum<A> &x) {
return OperatorSpelling{
x.ordering == Ordering::Less ? "MIN(" : "MAX(", ",", ")"};
x.ordering == Ordering::Less ? "min(" : "max(", ",", ")"};
}
template<int KIND>
constexpr OperatorSpelling SpellOperator(const Concat<KIND> &) {

View File

@ -54,28 +54,38 @@ static bool IsDescriptor(const ProcEntityDetails &details) {
return details.HasExplicitInterface();
}
bool IsDescriptor(const Symbol &symbol0) {
const Symbol &symbol{evaluate::ResolveAssociations(symbol0)};
if (const auto *objectDetails{symbol.detailsIf<ObjectEntityDetails>()}) {
return IsAllocatableOrPointer(symbol) || IsDescriptor(*objectDetails);
} else if (const auto *procDetails{symbol.detailsIf<ProcEntityDetails>()}) {
if (symbol.attrs().test(Attr::POINTER) ||
symbol.attrs().test(Attr::EXTERNAL)) {
return IsDescriptor(*procDetails);
}
} else if (const auto *assocDetails{symbol.detailsIf<AssocEntityDetails>()}) {
if (const auto &expr{assocDetails->expr()}) {
if (expr->Rank() > 0) {
return true;
}
if (const auto dynamicType{expr->GetType()}) {
if (dynamicType->RequiresDescriptor()) {
return true;
}
}
}
}
return false;
bool IsDescriptor(const Symbol &symbol) {
return std::visit(
common::visitors{
[&](const ObjectEntityDetails &d) {
return IsAllocatableOrPointer(symbol) || IsDescriptor(d);
},
[&](const ProcEntityDetails &d) {
return (symbol.attrs().test(Attr::POINTER) ||
symbol.attrs().test(Attr::EXTERNAL)) &&
IsDescriptor(d);
},
[](const AssocEntityDetails &d) {
if (const auto &expr{d.expr()}) {
if (expr->Rank() > 0) {
return true;
}
if (const auto dynamicType{expr->GetType()}) {
if (dynamicType->RequiresDescriptor()) {
return true;
}
}
}
return false;
},
[](const SubprogramDetails &d) {
return d.isFunction() && IsDescriptor(d.result());
},
[](const UseDetails &d) { return IsDescriptor(d.symbol()); },
[](const HostAssocDetails &d) { return IsDescriptor(d.symbol()); },
[](const auto &) { return false; },
},
symbol.details());
}
}

View File

@ -586,11 +586,13 @@ static const char *WhyBaseObjectIsSuspicious(
// Checks C1594(1,2)
void CheckDefinabilityInPureScope(parser::ContextualMessages &messages,
const Symbol &lhs, const Scope &scope) {
if (const char *why{WhyBaseObjectIsSuspicious(lhs, scope)}) {
evaluate::SayWithDeclaration(messages, lhs,
"A PURE subprogram may not define '%s' because it is %s"_err_en_US,
lhs.name(), why);
const Symbol &lhs, const Scope &context, const Scope &pure) {
if (pure.symbol()) {
if (const char *why{WhyBaseObjectIsSuspicious(lhs, context)}) {
evaluate::SayWithDeclaration(messages, lhs,
"PURE subprogram '%s' may not define '%s' because it is %s"_err_en_US,
pure.symbol()->name(), lhs.name(), why);
}
}
}
@ -624,13 +626,13 @@ void CheckCopyabilityInPureScope(parser::ContextualMessages &messages,
void AssignmentContext::CheckForPureContext(const SomeExpr &lhs,
const SomeExpr &rhs, parser::CharBlock source, bool isPointerAssignment) {
const Scope &scope{context_.FindScope(source)};
if (FindPureProcedureContaining(scope)) {
if (const Scope * pure{FindPureProcedureContaining(scope)}) {
parser::ContextualMessages messages{at_, &context_.messages()};
if (evaluate::ExtractCoarrayRef(lhs)) {
messages.Say(
"A PURE subprogram may not define a coindexed object"_err_en_US);
} else if (const Symbol * base{GetFirstSymbol(lhs)}) {
CheckDefinabilityInPureScope(messages, *base, scope);
CheckDefinabilityInPureScope(messages, *base, scope, *pure);
}
if (isPointerAssignment) {
if (const Symbol * base{GetFirstSymbol(rhs)}) {

View File

@ -55,8 +55,8 @@ extern template class Fortran::common::Indirection<
namespace Fortran::semantics {
// Applies checks from C1594(1-2) on definitions in PURE subprograms
void CheckDefinabilityInPureScope(
parser::ContextualMessages &, const Symbol &, const Scope &);
void CheckDefinabilityInPureScope(parser::ContextualMessages &, const Symbol &,
const Scope &context, const Scope &pure);
// Applies checks from C1594(5-6) on copying pointers in PURE subprograms
void CheckCopyabilityInPureScope(parser::ContextualMessages &,
const evaluate::Expr<evaluate::SomeType> &, const Scope &);

View File

@ -425,35 +425,39 @@ void IoChecker::Enter(const parser::StatusExpr &spec) {
}
void IoChecker::Enter(const parser::StatVariable &) {
SetSpecifier(IoSpecKind::Iostat);
if (stmt_ == IoStmtKind::None) {
// ALLOCATE & DEALLOCATE
} else {
SetSpecifier(IoSpecKind::Iostat);
}
}
void IoChecker::Leave(const parser::BackspaceStmt &) {
CheckForPureSubprogram();
CheckForRequiredSpecifier(
flags_.test(Flag::NumberUnit), "UNIT number"); // C1240
stmt_ = IoStmtKind::None;
Done();
}
void IoChecker::Leave(const parser::CloseStmt &) {
CheckForPureSubprogram();
CheckForRequiredSpecifier(
flags_.test(Flag::NumberUnit), "UNIT number"); // C1208
stmt_ = IoStmtKind::None;
Done();
}
void IoChecker::Leave(const parser::EndfileStmt &) {
CheckForPureSubprogram();
CheckForRequiredSpecifier(
flags_.test(Flag::NumberUnit), "UNIT number"); // C1240
stmt_ = IoStmtKind::None;
Done();
}
void IoChecker::Leave(const parser::FlushStmt &) {
CheckForPureSubprogram();
CheckForRequiredSpecifier(
flags_.test(Flag::NumberUnit), "UNIT number"); // C1243
stmt_ = IoStmtKind::None;
Done();
}
void IoChecker::Leave(const parser::InquireStmt &stmt) {
@ -466,7 +470,7 @@ void IoChecker::Leave(const parser::InquireStmt &stmt) {
CheckForProhibitedSpecifier(IoSpecKind::File, IoSpecKind::Unit); // C1246
CheckForRequiredSpecifier(IoSpecKind::Id, IoSpecKind::Pending); // C1248
}
stmt_ = IoStmtKind::None;
Done();
}
void IoChecker::Leave(const parser::OpenStmt &) {
@ -499,12 +503,12 @@ void IoChecker::Leave(const parser::OpenStmt &) {
CheckForProhibitedSpecifier(flags_.test(Flag::AccessStream),
"STATUS='STREAM'", IoSpecKind::Recl); // 12.5.6.15
}
stmt_ = IoStmtKind::None;
Done();
}
void IoChecker::Leave(const parser::PrintStmt &) {
CheckForPureSubprogram();
stmt_ = IoStmtKind::None;
Done();
}
void IoChecker::Leave(const parser::ReadStmt &) {
@ -512,6 +516,7 @@ void IoChecker::Leave(const parser::ReadStmt &) {
CheckForPureSubprogram();
}
if (!flags_.test(Flag::IoControlList)) {
Done();
return;
}
LeaveReadWrite();
@ -525,21 +530,21 @@ void IoChecker::Leave(const parser::ReadStmt &) {
"FMT or NML"); // C1227
CheckForRequiredSpecifier(
IoSpecKind::Pad, flags_.test(Flag::FmtOrNml), "FMT or NML"); // C1227
stmt_ = IoStmtKind::None;
Done();
}
void IoChecker::Leave(const parser::RewindStmt &) {
CheckForRequiredSpecifier(
flags_.test(Flag::NumberUnit), "UNIT number"); // C1240
CheckForPureSubprogram();
stmt_ = IoStmtKind::None;
Done();
}
void IoChecker::Leave(const parser::WaitStmt &) {
CheckForRequiredSpecifier(
flags_.test(Flag::NumberUnit), "UNIT number"); // C1237
CheckForPureSubprogram();
stmt_ = IoStmtKind::None;
Done();
}
void IoChecker::Leave(const parser::WriteStmt &) {
@ -557,7 +562,7 @@ void IoChecker::Leave(const parser::WriteStmt &) {
CheckForRequiredSpecifier(IoSpecKind::Delim,
flags_.test(Flag::StarFmt) || specifierSet_.test(IoSpecKind::Nml),
"FMT=* or NML"); // C1228
stmt_ = IoStmtKind::None;
Done();
}
void IoChecker::LeaveReadWrite() const {

View File

@ -134,10 +134,12 @@ private:
flags_.reset();
}
void Done() { stmt_ = IoStmtKind::None; }
void CheckForPureSubprogram() const;
SemanticsContext &context_;
IoStmtKind stmt_ = IoStmtKind::None;
IoStmtKind stmt_{IoStmtKind::None};
common::EnumSet<IoSpecKind, common::IoSpecKind_enumSize> specifierSet_;
common::EnumSet<Flag, Flag_enumSize> flags_;
};

View File

@ -25,7 +25,7 @@ namespace Fortran::semantics {
void NullifyChecker::Leave(const parser::NullifyStmt &nullifyStmt) {
CHECK(context_.location());
const Scope &scope{context_.FindScope(*context_.location())};
bool isPure{FindPureProcedureContaining(scope)};
const Scope *pure{FindPureProcedureContaining(scope)};
parser::ContextualMessages messages{
*context_.location(), &context_.messages()};
for (const parser::PointerObject &pointerObject : nullifyStmt.v) {
@ -41,8 +41,8 @@ void NullifyChecker::Leave(const parser::NullifyStmt &nullifyStmt) {
} else if (!IsPointer(symbol)) { // C951
messages.Say(name.source,
"name in NULLIFY statement must have the POINTER attribute"_err_en_US);
} else if (isPure) {
CheckDefinabilityInPureScope(messages, symbol, scope);
} else if (pure) {
CheckDefinabilityInPureScope(messages, symbol, scope, *pure);
}
},
[&](const parser::StructureComponent &structureComponent) {
@ -51,8 +51,11 @@ void NullifyChecker::Leave(const parser::NullifyStmt &nullifyStmt) {
if (!IsPointer(*structureComponent.component.symbol)) { // C951
messages.Say(structureComponent.component.source,
"component in NULLIFY statement must have the POINTER attribute"_err_en_US);
} else if (const Symbol * symbol{GetFirstSymbol(checked)}) {
CheckDefinabilityInPureScope(messages, *symbol, scope);
} else if (pure) {
if (const Symbol * symbol{GetFirstSymbol(checked)}) {
CheckDefinabilityInPureScope(
messages, *symbol, scope, *pure);
}
}
}
},
@ -67,4 +70,4 @@ void NullifyChecker::Leave(const parser::NullifyStmt &nullifyStmt) {
// Some dependencies can be found compile time or at
// runtime, but for now we choose to skip such checks.
}
} // namespace Fortran::semantics
}

View File

@ -101,8 +101,8 @@ struct SetExprHelper {
template<typename T> void Set(const T &x) {
if constexpr (ConstraintTrait<T>) {
Set(x.thing);
} else {
static_assert("bad type");
} else if constexpr (WrapperTrait<T>) {
Set(x.v);
}
}

View File

@ -5916,7 +5916,7 @@ bool ResolveNamesVisitor::BeginScope(const ProgramTree &node) {
}
// Some analyses and checks, such as the processing of initializers of
// pointers, is deferred until all of the pertinent specification parts
// pointers, are deferred until all of the pertinent specification parts
// have been visited. This deferred processing enables the use of forward
// references in these circumstances.
class DeferredCheckVisitor {
@ -6020,7 +6020,8 @@ void ResolveNamesVisitor::FinishSpecificationParts(const ProgramTree &node) {
// type parameter values of a particular instantiation.
void ResolveNamesVisitor::FinishDerivedTypeInstantiation(Scope &scope) {
CHECK(scope.IsDerivedType() && !scope.symbol());
if (const DerivedTypeSpec * spec{scope.derivedTypeSpec()}) {
if (DerivedTypeSpec * spec{scope.derivedTypeSpec()}) {
spec->Instantiate(currScope(), context());
const Symbol &origTypeSymbol{spec->typeSymbol()};
if (const Scope * origTypeScope{origTypeSymbol.scope()}) {
CHECK(origTypeScope->IsDerivedType() &&

View File

@ -197,9 +197,8 @@ public:
void add_importName(const SourceName &);
const DerivedTypeSpec *derivedTypeSpec() const { return derivedTypeSpec_; }
void set_derivedTypeSpec(const DerivedTypeSpec &spec) {
derivedTypeSpec_ = &spec;
}
DerivedTypeSpec *derivedTypeSpec() { return derivedTypeSpec_; }
void set_derivedTypeSpec(DerivedTypeSpec &spec) { derivedTypeSpec_ = &spec; }
// The range of the source of this and nested scopes.
const parser::CharBlock &sourceRange() const { return sourceRange_; }
@ -234,7 +233,7 @@ private:
std::string chars_;
std::optional<ImportKind> importKind_;
std::set<SourceName> importNames_;
const DerivedTypeSpec *derivedTypeSpec_{nullptr}; // dTS->scope() == this
DerivedTypeSpec *derivedTypeSpec_{nullptr}; // dTS->scope() == this
// When additional data members are added to Scope, remember to
// copy them, if appropriate, in InstantiateDerivedType().

View File

@ -204,8 +204,11 @@ void DerivedTypeSpec::Instantiate(
const Symbol &symbol{*pair.second};
if (const DeclTypeSpec * type{symbol.GetType()}) {
if (const DerivedTypeSpec * derived{type->AsDerived()}) {
auto &instantiatable{*const_cast<DerivedTypeSpec *>(derived)};
instantiatable.Instantiate(containingScope, context);
if (!(derived->IsForwardReferenced() &&
IsAllocatableOrPointer(symbol))) {
auto &instantiatable{*const_cast<DerivedTypeSpec *>(derived)};
instantiatable.Instantiate(containingScope, context);
}
}
}
}

View File

@ -42,21 +42,21 @@ module m
type(hasCoarray), pointer :: hcp
integer :: n
common /block/ y
!ERROR: A PURE subprogram may not define 'x' because it is host-associated
!ERROR: PURE subprogram 'test' may not define 'x' because it is host-associated
x%a = 0.
!ERROR: A PURE subprogram may not define 'y' because it is in a COMMON block
!ERROR: PURE subprogram 'test' may not define 'y' because it is in a COMMON block
y%a = 0. ! C1594(1)
!ERROR: A PURE subprogram may not define 'useassociated' because it is USE-associated
!ERROR: PURE subprogram 'test' may not define 'useassociated' because it is USE-associated
useassociated = 0. ! C1594(1)
!ERROR: A PURE subprogram may not define 'ptr' because it is a POINTER dummy argument of a PURE function
!ERROR: PURE subprogram 'test' may not define 'ptr' because it is a POINTER dummy argument of a PURE function
ptr%a = 0. ! C1594(1)
!ERROR: A PURE subprogram may not define 'in' because it is an INTENT(IN) dummy argument
!ERROR: PURE subprogram 'test' may not define 'in' because it is an INTENT(IN) dummy argument
in%a = 0. ! C1594(1)
!ERROR: A PURE subprogram may not define a coindexed object
hcp%co[1] = 0. ! C1594(1)
!ERROR: A PURE subprogram may not define 'ptr' because it is a POINTER dummy argument of a PURE function
!ERROR: PURE subprogram 'test' may not define 'ptr' because it is a POINTER dummy argument of a PURE function
ptr => z ! C1594(2)
!ERROR: A PURE subprogram may not define 'ptr' because it is a POINTER dummy argument of a PURE function
!ERROR: PURE subprogram 'test' may not define 'ptr' because it is a POINTER dummy argument of a PURE function
nullify(ptr) ! C1594(2), 19.6.8
!ERROR: A PURE subprogram may not use 'ptr' as the target of pointer assignment because it is a POINTER dummy argument of a PURE function
ptr2 => ptr ! C1594(3)
@ -79,7 +79,7 @@ module m
contains
pure subroutine internal
type(hasPtr) :: localhp
!ERROR: A PURE subprogram may not define 'z' because it is host-associated
!ERROR: PURE subprogram 'internal' may not define 'z' because it is host-associated
z%a = 0.
!ERROR: Externally visible object 'z' may not be associated with pointer component 'p' in a PURE procedure
localhp = hasPtr(z%a)