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)};
},
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>
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);
}
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.", "", ""};
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> &) {
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());
}
}
// 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);
+ }
}
}
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)}) {
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 &);
}
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) {
CheckForProhibitedSpecifier(IoSpecKind::File, IoSpecKind::Unit); // C1246
CheckForRequiredSpecifier(IoSpecKind::Id, IoSpecKind::Pending); // C1248
}
- stmt_ = IoStmtKind::None;
+ Done();
}
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 &) {
CheckForPureSubprogram();
}
if (!flags_.test(Flag::IoControlList)) {
+ Done();
return;
}
LeaveReadWrite();
"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 &) {
CheckForRequiredSpecifier(IoSpecKind::Delim,
flags_.test(Flag::StarFmt) || specifierSet_.test(IoSpecKind::Nml),
"FMT=* or NML"); // C1228
- stmt_ = IoStmtKind::None;
+ Done();
}
void IoChecker::LeaveReadWrite() const {
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_;
};
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) {
} 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) {
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);
+ }
}
}
},
// Some dependencies can be found compile time or at
// runtime, but for now we choose to skip such checks.
}
-} // namespace Fortran::semantics
+}
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);
}
}
}
// 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 {
// 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() &&
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_; }
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().
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);
+ }
}
}
}
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)
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)
projects / platform / upstream / llvm.git / commitdiff