const IntrinsicProcTable &, const ProcedureRef &);
} // namespace Fortran::evaluate
+
+namespace Fortran::semantics {
+
+class Scope;
+
+// These functions are used in Evaluate so they are defined here rather than in
+// Semantics to avoid a link-time dependency on Semantics.
+
+bool IsVariableName(const Symbol &);
+bool IsPureProcedure(const Symbol &);
+bool IsPureProcedure(const Scope &);
+bool IsFunction(const Symbol &);
+bool IsProcedure(const Symbol &);
+bool IsProcedurePointer(const Symbol &);
+bool IsSaved(const Symbol &); // saved implicitly or explicitly
+bool IsDummy(const Symbol &);
+
+// Follow use, host, and construct assocations to a variable, if any.
+const Symbol *GetAssociationRoot(const Symbol &);
+const Symbol *FindCommonBlockContaining(const Symbol &);
+int CountLenParameters(const DerivedTypeSpec &);
+const Symbol &GetUsedModule(const UseDetails &);
+
+} // namespace Fortran::semantics
+
#endif // FORTRAN_EVALUATE_TOOLS_H_
Symbol *symbol() { return symbol_; }
const Symbol *symbol() const { return symbol_; }
- const Symbol *GetSymbol() const;
+ inline const Symbol *GetSymbol() const;
const Scope *GetDerivedTypeParent() const;
const Scope &GetDerivedTypeBase() const;
std::optional<SourceName> GetName() const;
friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const Scope &);
};
+
+// Inline so that it can be called from Evaluate without a link-time dependency.
+
+inline const Symbol *Scope::GetSymbol() const {
+ return symbol_ ? symbol_
+ : derivedTypeSpec_ ? &derivedTypeSpec_->typeSymbol() : nullptr;
+}
+
} // namespace Fortran::semantics
#endif // FORTRAN_SEMANTICS_SCOPE_H_
: location_{location}, symbol_{symbol} {}
const SourceName &location() const { return location_; }
const Symbol &symbol() const { return symbol_; }
- const Symbol &module() const;
private:
SourceName location_;
bool CanReplaceDetails(const Details &details) const;
// Follow use-associations and host-associations to get the ultimate entity.
- Symbol &GetUltimate() {
- return const_cast<Symbol &>(
- const_cast<const Symbol *>(this)->GetUltimate());
- }
- const Symbol &GetUltimate() const {
- if (const auto *details{detailsIf<UseDetails>()}) {
- return details->symbol().GetUltimate();
- } else if (const auto *details{detailsIf<HostAssocDetails>()}) {
- return details->symbol().GetUltimate();
- } else {
- return *this;
- }
- }
+ inline Symbol &GetUltimate();
+ inline const Symbol &GetUltimate() const;
- DeclTypeSpec *GetType() {
- return const_cast<DeclTypeSpec *>(
- const_cast<const Symbol *>(this)->GetType());
- }
- const DeclTypeSpec *GetType() const {
- return std::visit(
- common::visitors{
- [](const EntityDetails &x) { return x.type(); },
- [](const ObjectEntityDetails &x) { return x.type(); },
- [](const AssocEntityDetails &x) { return x.type(); },
- [](const SubprogramDetails &x) {
- return x.isFunction() ? x.result().GetType() : nullptr;
- },
- [](const ProcEntityDetails &x) {
- if (const Symbol * symbol{x.interface().symbol()}) {
- return symbol->GetType();
- } else {
- return x.interface().type();
- }
- },
- [&](const ProcBindingDetails &x) { return x.symbol().GetType(); },
- [](const TypeParamDetails &x) { return x.type(); },
- [](const UseDetails &x) { return x.symbol().GetType(); },
- [](const HostAssocDetails &x) { return x.symbol().GetType(); },
- [](const auto &) -> const DeclTypeSpec * { return nullptr; },
- },
- details_);
- }
+ inline DeclTypeSpec *GetType();
+ inline const DeclTypeSpec *GetType() const;
void SetType(const DeclTypeSpec &);
- bool IsDummy() const;
bool IsFuncResult() const;
bool IsObjectArray() const;
bool IsSubprogram() const;
return false;
}
+inline Symbol &Symbol::GetUltimate() {
+ return const_cast<Symbol &>(const_cast<const Symbol *>(this)->GetUltimate());
+}
+inline const Symbol &Symbol::GetUltimate() const {
+ if (const auto *details{detailsIf<UseDetails>()}) {
+ return details->symbol().GetUltimate();
+ } else if (const auto *details{detailsIf<HostAssocDetails>()}) {
+ return details->symbol().GetUltimate();
+ } else {
+ return *this;
+ }
+}
+
+inline DeclTypeSpec *Symbol::GetType() {
+ return const_cast<DeclTypeSpec *>(
+ const_cast<const Symbol *>(this)->GetType());
+}
+inline const DeclTypeSpec *Symbol::GetType() const {
+ return std::visit(
+ common::visitors{
+ [](const EntityDetails &x) { return x.type(); },
+ [](const ObjectEntityDetails &x) { return x.type(); },
+ [](const AssocEntityDetails &x) { return x.type(); },
+ [](const SubprogramDetails &x) {
+ return x.isFunction() ? x.result().GetType() : nullptr;
+ },
+ [](const ProcEntityDetails &x) {
+ const Symbol *symbol{x.interface().symbol()};
+ return symbol ? symbol->GetType() : x.interface().type();
+ },
+ [](const ProcBindingDetails &x) { return x.symbol().GetType(); },
+ [](const TypeParamDetails &x) { return x.type(); },
+ [](const UseDetails &x) { return x.symbol().GetType(); },
+ [](const HostAssocDetails &x) { return x.symbol().GetType(); },
+ [](const auto &) -> const DeclTypeSpec * { return nullptr; },
+ },
+ details_);
+}
+
inline bool operator<(SymbolRef x, SymbolRef y) { return *x < *y; }
inline bool operator<(MutableSymbolRef x, MutableSymbolRef y) {
return *x < *y;
class Symbol;
const Scope *FindModuleContaining(const Scope &);
-const Symbol *FindCommonBlockContaining(const Symbol &object);
const Scope *FindProgramUnitContaining(const Scope &);
const Scope *FindProgramUnitContaining(const Symbol &);
const Scope *FindPureProcedureContaining(const Scope &);
const DeclTypeSpec *FindParentTypeSpec(const Scope &);
const DeclTypeSpec *FindParentTypeSpec(const Symbol &);
-// Return the Symbol of the variable of a construct association, if it exists
-const Symbol *GetAssociationRoot(const Symbol &);
-
enum class Tristate { No, Yes, Maybe };
inline Tristate ToTristate(bool x) { return x ? Tristate::Yes : Tristate::No; }
bool DoesScopeContain(const Scope *, const Symbol &);
bool IsUseAssociated(const Symbol &, const Scope &);
bool IsHostAssociated(const Symbol &, const Scope &);
-bool IsDummy(const Symbol &);
-bool IsStmtFunction(const Symbol &);
+inline bool IsStmtFunction(const Symbol &symbol) {
+ const auto *subprogram{symbol.detailsIf<SubprogramDetails>()};
+ return subprogram && subprogram->stmtFunction();
+}
bool IsInStmtFunction(const Symbol &);
bool IsStmtFunctionDummy(const Symbol &);
bool IsStmtFunctionResult(const Symbol &);
bool IsPointerDummy(const Symbol &);
-bool IsFunction(const Symbol &);
-bool IsPureProcedure(const Symbol &);
-bool IsPureProcedure(const Scope &);
bool IsBindCProcedure(const Symbol &);
bool IsBindCProcedure(const Scope &);
-bool IsProcedure(const Symbol &);
bool IsProcName(const Symbol &symbol); // proc-name
-bool IsVariableName(const Symbol &symbol); // variable-name
-bool IsProcedurePointer(const Symbol &);
bool IsFunctionResult(const Symbol &);
bool IsFunctionResultWithSameNameAsFunction(const Symbol &);
bool IsExtensibleType(const DerivedTypeSpec *);
bool IsIsoCType(const DerivedTypeSpec *);
bool IsEventTypeOrLockType(const DerivedTypeSpec *);
bool IsOrContainsEventOrLockComponent(const Symbol &);
-// Has an explicit or implied SAVE attribute
-bool IsSaved(const Symbol &);
bool CanBeTypeBoundProc(const Symbol *);
bool IsInitialized(const Symbol &);
bool HasIntrinsicTypeName(const Symbol &);
struct ArraySpec : public std::vector<ShapeSpec> {
ArraySpec() {}
int Rank() const { return size(); }
- bool IsExplicitShape() const;
- bool IsAssumedShape() const;
- bool IsDeferredShape() const;
- bool IsImpliedShape() const;
- bool IsAssumedSize() const;
- bool IsAssumedRank() const;
- bool IsConstantShape() const; // explicit shape with constant bounds
+ inline bool IsExplicitShape() const;
+ inline bool IsAssumedShape() const;
+ inline bool IsDeferredShape() const;
+ inline bool IsImpliedShape() const;
+ inline bool IsAssumedSize() const;
+ inline bool IsAssumedRank() const;
private:
// Check non-empty and predicate is true for each element.
void ReplaceScope(const Scope &);
RawParameters &rawParameters() { return rawParameters_; }
const ParameterMapType ¶meters() const { return parameters_; }
- int NumLengthParameters() const;
bool MightBeParameterized() const;
bool IsForwardReferenced() const;
return std::get<DerivedTypeSpec>(typeSpec_);
}
- IntrinsicTypeSpec *AsIntrinsic();
- const IntrinsicTypeSpec *AsIntrinsic() const;
- DerivedTypeSpec *AsDerived();
- const DerivedTypeSpec *AsDerived() const;
+ inline IntrinsicTypeSpec *AsIntrinsic();
+ inline const IntrinsicTypeSpec *AsIntrinsic() const;
+ inline DerivedTypeSpec *AsDerived();
+ inline const DerivedTypeSpec *AsDerived() const;
std::string AsFortran() const;
const Symbol *symbol_{nullptr};
const DeclTypeSpec *type_{nullptr};
};
+
+// Define some member functions here in the header so that they can be used by
+// lib/Evaluate without link-time dependency on Semantics.
+
+inline bool ArraySpec::IsExplicitShape() const {
+ return CheckAll([](const ShapeSpec &x) { return x.ubound().isExplicit(); });
+}
+inline bool ArraySpec::IsAssumedShape() const {
+ return CheckAll([](const ShapeSpec &x) { return x.ubound().isDeferred(); });
+}
+inline bool ArraySpec::IsDeferredShape() const {
+ return CheckAll([](const ShapeSpec &x) {
+ return x.lbound().isDeferred() && x.ubound().isDeferred();
+ });
+}
+inline bool ArraySpec::IsImpliedShape() const {
+ return !IsAssumedRank() &&
+ CheckAll([](const ShapeSpec &x) { return x.ubound().isAssumed(); });
+}
+inline bool ArraySpec::IsAssumedSize() const {
+ return !empty() && !IsAssumedRank() && back().ubound().isAssumed() &&
+ std::all_of(begin(), end() - 1,
+ [](const ShapeSpec &x) { return x.ubound().isExplicit(); });
+}
+inline bool ArraySpec::IsAssumedRank() const {
+ return Rank() == 1 && front().lbound().isAssumed();
+}
+
+inline IntrinsicTypeSpec *DeclTypeSpec::AsIntrinsic() {
+ switch (category_) {
+ case Numeric:
+ return &std::get<NumericTypeSpec>(typeSpec_);
+ case Logical:
+ return &std::get<LogicalTypeSpec>(typeSpec_);
+ case Character:
+ return &std::get<CharacterTypeSpec>(typeSpec_);
+ default:
+ return nullptr;
+ }
+}
+inline const IntrinsicTypeSpec *DeclTypeSpec::AsIntrinsic() const {
+ return const_cast<DeclTypeSpec *>(this)->AsIntrinsic();
+}
+
+inline DerivedTypeSpec *DeclTypeSpec::AsDerived() {
+ switch (category_) {
+ case TypeDerived:
+ case ClassDerived:
+ return &std::get<DerivedTypeSpec>(typeSpec_);
+ default:
+ return nullptr;
+ }
+}
+inline const DerivedTypeSpec *DeclTypeSpec::AsDerived() const {
+ return const_cast<DeclTypeSpec *>(this)->AsDerived();
+}
+
} // namespace Fortran::semantics
#endif // FORTRAN_SEMANTICS_TYPE_H_
return "derived type component or type parameter value not allowed to "
"reference variable '"s +
symbol.name().ToString() + "'";
- } else if (symbol.IsDummy()) {
+ } else if (IsDummy(symbol)) {
if (symbol.attrs().test(semantics::Attr::OPTIONAL)) {
return "reference to OPTIONAL dummy argument '"s +
symbol.name().ToString() + "'";
if (const auto *use{symbol.detailsIf<semantics::UseDetails>()}) {
message.Attach(use->location(),
"'%s' is USE-associated with '%s' in module '%s'"_en_US, symbol.name(),
- unhosted->name(), use->module().name());
+ unhosted->name(), GetUsedModule(*use).name());
} else {
message.Attach(
unhosted->name(), "Declaration of '%s'"_en_US, unhosted->name());
}
} // namespace Fortran::evaluate
+
+namespace Fortran::semantics {
+
+// When a construct association maps to a variable, and that variable
+// is not an array with a vector-valued subscript, return the base
+// Symbol of that variable, else nullptr. Descends into other construct
+// associations when one associations maps to another.
+static const Symbol *GetAssociatedVariable(
+ const semantics::AssocEntityDetails &details) {
+ if (const auto &expr{details.expr()}) {
+ if (IsVariable(*expr) && !HasVectorSubscript(*expr)) {
+ if (const Symbol * varSymbol{GetFirstSymbol(*expr)}) {
+ return GetAssociationRoot(*varSymbol);
+ }
+ }
+ }
+ return nullptr;
+}
+
+const Symbol *GetAssociationRoot(const Symbol &symbol) {
+ const Symbol &ultimate{symbol.GetUltimate()};
+ const auto *details{ultimate.detailsIf<semantics::AssocEntityDetails>()};
+ return details ? GetAssociatedVariable(*details) : &ultimate;
+}
+
+bool IsVariableName(const Symbol &symbol) {
+ const Symbol *root{GetAssociationRoot(symbol)};
+ return root && root->has<ObjectEntityDetails>() && !IsNamedConstant(*root);
+}
+
+bool IsPureProcedure(const Symbol &symbol) {
+ if (const auto *procDetails{symbol.detailsIf<ProcEntityDetails>()}) {
+ if (const Symbol * procInterface{procDetails->interface().symbol()}) {
+ // procedure component with a pure interface
+ return IsPureProcedure(*procInterface);
+ }
+ } else if (const auto *details{symbol.detailsIf<ProcBindingDetails>()}) {
+ return IsPureProcedure(details->symbol());
+ } else if (!IsProcedure(symbol)) {
+ return false;
+ }
+ if (IsStmtFunction(symbol)) {
+ // Section 15.7(1) states that a statement function is PURE if it does not
+ // reference an IMPURE procedure or a VOLATILE variable
+ if (const auto &expr{symbol.get<SubprogramDetails>().stmtFunction()}) {
+ for (const SymbolRef &ref : evaluate::CollectSymbols(*expr)) {
+ if (IsFunction(*ref) && !IsPureProcedure(*ref)) {
+ return false;
+ }
+ const Symbol *root{GetAssociationRoot(*ref)};
+ if (root && root->attrs().test(Attr::VOLATILE)) {
+ return false;
+ }
+ }
+ }
+ return true; // statement function was not found to be impure
+ }
+ return symbol.attrs().test(Attr::PURE) ||
+ (symbol.attrs().test(Attr::ELEMENTAL) &&
+ !symbol.attrs().test(Attr::IMPURE));
+}
+
+bool IsPureProcedure(const Scope &scope) {
+ const Symbol *symbol{scope.GetSymbol()};
+ return symbol && IsPureProcedure(*symbol);
+}
+
+bool IsFunction(const Symbol &symbol) {
+ return std::visit(
+ common::visitors{
+ [](const SubprogramDetails &x) { return x.isFunction(); },
+ [&](const SubprogramNameDetails &) {
+ return symbol.test(Symbol::Flag::Function);
+ },
+ [](const ProcEntityDetails &x) {
+ const auto &ifc{x.interface()};
+ return ifc.type() || (ifc.symbol() && IsFunction(*ifc.symbol()));
+ },
+ [](const ProcBindingDetails &x) { return IsFunction(x.symbol()); },
+ [](const UseDetails &x) { return IsFunction(x.symbol()); },
+ [](const auto &) { return false; },
+ },
+ symbol.details());
+}
+
+bool IsProcedure(const Symbol &symbol) {
+ return std::visit(
+ common::visitors{
+ [](const SubprogramDetails &) { return true; },
+ [](const SubprogramNameDetails &) { return true; },
+ [](const ProcEntityDetails &) { return true; },
+ [](const GenericDetails &) { return true; },
+ [](const ProcBindingDetails &) { return true; },
+ [](const UseDetails &x) { return IsProcedure(x.symbol()); },
+ // TODO: FinalProcDetails?
+ [](const auto &) { return false; },
+ },
+ symbol.details());
+}
+
+const Symbol *FindCommonBlockContaining(const Symbol &object) {
+ const auto *details{object.detailsIf<ObjectEntityDetails>()};
+ return details ? details->commonBlock() : nullptr;
+}
+
+bool IsProcedurePointer(const Symbol &symbol) {
+ return symbol.has<ProcEntityDetails>() && IsPointer(symbol);
+}
+
+bool IsSaved(const Symbol &symbol) {
+ auto scopeKind{symbol.owner().kind()};
+ if (scopeKind == Scope::Kind::Module || scopeKind == Scope::Kind::BlockData) {
+ return true;
+ } else if (scopeKind == Scope::Kind::DerivedType) {
+ return false; // this is a component
+ } else if (IsNamedConstant(symbol)) {
+ return false;
+ } else if (symbol.attrs().test(Attr::SAVE)) {
+ return true;
+ } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()};
+ object && object->init()) {
+ return true;
+ } else if (IsProcedurePointer(symbol) &&
+ symbol.get<ProcEntityDetails>().init()) {
+ return true;
+ } else if (const Symbol * block{FindCommonBlockContaining(symbol)};
+ block && block->attrs().test(Attr::SAVE)) {
+ return true;
+ } else {
+ return false;
+ }
+}
+
+bool IsDummy(const Symbol &symbol) {
+ return std::visit(
+ common::visitors{[](const EntityDetails &x) { return x.isDummy(); },
+ [](const ObjectEntityDetails &x) { return x.isDummy(); },
+ [](const ProcEntityDetails &x) { return x.isDummy(); },
+ [](const HostAssocDetails &x) { return IsDummy(x.symbol()); },
+ [](const auto &) { return false; }},
+ symbol.details());
+}
+
+int CountLenParameters(const DerivedTypeSpec &type) {
+ return std::count_if(type.parameters().begin(), type.parameters().end(),
+ [](const auto &pair) { return pair.second.isLen(); });
+}
+
+const Symbol &GetUsedModule(const UseDetails &details) {
+ return DEREF(details.symbol().owner().symbol());
+}
+
+} // namespace Fortran::semantics
// IsDescriptor() predicate
// TODO there's probably a better place for this predicate than here
namespace Fortran::semantics {
+
static bool IsDescriptor(const ObjectEntityDetails &details) {
if (const auto *type{details.type()}) {
if (auto dynamicType{evaluate::DynamicType::From(*type)}) {
}
}
// TODO: Automatic (adjustable) arrays - are they descriptors?
- return !details.shape().empty() && !details.shape().IsConstantShape();
+ for (const ShapeSpec &shapeSpec : details.shape()) {
+ const auto &lb{shapeSpec.lbound().GetExplicit()};
+ const auto &ub{shapeSpec.ubound().GetExplicit()};
+ if (!lb || !ub || !IsConstantExpr(*lb) || !IsConstantExpr(*ub)) {
+ return true;
+ }
+ }
+ return false;
}
static bool IsDescriptor(const ProcEntityDetails &details) {
bool DynamicType::RequiresDescriptor() const {
return IsPolymorphic() || IsUnknownLengthCharacter() ||
- (derived_ && derived_->NumLengthParameters() > 0);
+ (derived_ && CountLenParameters(*derived_) > 0);
}
bool DynamicType::HasDeferredTypeParameter() const {
const Symbol &symbol, const ObjectEntityDetails &details) {
if (const DeclTypeSpec * type{symbol.GetType()};
type && type->category() == DeclTypeSpec::TypeStar) {
- if (!symbol.IsDummy()) {
+ if (!IsDummy(symbol)) {
messages_.Say(
"Assumed-type entity '%s' must be a dummy argument"_err_en_US,
symbol.name());
if (const DeclTypeSpec * type{details.type()}) { // C708
if (type->IsPolymorphic() &&
!(type->IsAssumedType() || IsAllocatableOrPointer(symbol) ||
- symbol.IsDummy())) {
+ IsDummy(symbol))) {
messages_.Say("CLASS entity '%s' must be a dummy argument or have "
"ALLOCATABLE or POINTER attribute"_err_en_US,
symbol.name());
" assumed rank"_err_en_US;
}
}
- } else if (symbol.IsDummy()) {
+ } else if (IsDummy(symbol)) {
if (isImplied && !isAssumedSize) { // C836
msg = "Dummy array argument '%s' may not have implied shape"_err_en_US;
}
if (IsDescriptor(symbol) || IsProcedure(symbol)) {
int lenParams{0};
if (const DerivedTypeSpec * derived{type->AsDerived()}) {
- lenParams = derived->NumLengthParameters();
+ lenParams = CountLenParameters(*derived);
}
std::size_t size{
runtime::Descriptor::SizeInBytes(symbol.Rank(), false, lenParams)};
void ModFileWriter::PutUse(const Symbol &symbol) {
auto &details{symbol.get<UseDetails>()};
auto &use{details.symbol()};
- uses_ << "use " << details.module().name();
+ uses_ << "use " << GetUsedModule(details).name();
PutGenericName(uses_ << ",only:", symbol);
// Can have intrinsic op with different local-name and use-name
// (e.g. `operator(<)` and `operator(.lt.)`) but rename is not allowed
if (symbol.owner().IsDerivedType()) { // C8107
msg = "Derived type component '%s'"
" is not allowed in an equivalence set"_err_en_US;
- } else if (symbol.IsDummy()) { // C8106
+ } else if (IsDummy(symbol)) { // C8106
msg = "Dummy argument '%s' is not allowed in an equivalence set"_err_en_US;
} else if (symbol.IsFuncResult()) { // C8106
msg = "Function result '%s' is not allow in an equivalence set"_err_en_US;
} else if (auto *details{symbol.detailsIf<UseDetails>()}) {
Say(name.source,
"'%s' is use-associated from module '%s' and cannot be re-declared"_err_en_US,
- name.source, details->module().name());
+ name.source, GetUsedModule(*details).name());
} else if (auto *details{symbol.detailsIf<SubprogramNameDetails>()}) {
if (details->kind() == SubprogramKind::Module) {
Say2(name,
Say(name, "'%s' is already declared in this scoping unit"_err_en_US)
.Attach(details->location(),
"It is use-associated with '%s' in module '%s'"_err_en_US,
- details->symbol().name(), details->module().name());
+ details->symbol().name(), GetUsedModule(*details).name());
} else {
SayAlreadyDeclared(name, prev.name());
}
Say(location,
"Generic interface '%s' has ambiguous specific procedures"
" from modules '%s' and '%s'"_err_en_US,
- localSymbol.name(), useDetails->module().name(),
+ localSymbol.name(), GetUsedModule(*useDetails).name(),
useSymbol.owner().GetName().value());
} else if (generic1.derivedType() && generic2.derivedType() &&
generic1.derivedType() != generic2.derivedType()) {
Say(location,
"Generic interface '%s' has ambiguous derived types"
" from modules '%s' and '%s'"_err_en_US,
- localSymbol.name(), useDetails->module().name(),
+ localSymbol.name(), GetUsedModule(*useDetails).name(),
useSymbol.owner().GetName().value());
} else {
generic1.CopyFrom(generic2);
// If SAVE attribute can't be set on symbol, return error message.
std::optional<MessageFixedText> DeclarationVisitor::CheckSaveAttr(
const Symbol &symbol) {
- if (symbol.IsDummy()) {
+ if (IsDummy(symbol)) {
return "SAVE attribute may not be applied to dummy argument '%s'"_err_en_US;
} else if (symbol.IsFuncResult()) {
return "SAVE attribute may not be applied to function result '%s'"_err_en_US;
} else if (attrs.test(Attr::BIND_C)) {
Say(name,
"Variable '%s' with BIND attribute may not appear in a COMMON block"_err_en_US);
- } else if (symbol->IsDummy()) {
+ } else if (IsDummy(*symbol)) {
Say(name,
"Dummy argument '%s' may not appear in a COMMON block"_err_en_US);
} else if (symbol->IsFuncResult()) {
return false;
}
if (const DeclTypeSpec * type{symbol.GetType()}) {
- if (type->IsPolymorphic() && symbol.IsDummy() &&
+ if (type->IsPolymorphic() && IsDummy(symbol) &&
!IsPointer(symbol)) { // C1128
SayWithDecl(name, symbol,
"Nonpointer polymorphic argument '%s' not allowed in a "
if (CheckUseError(name)) {
return nullptr; // reported an error
}
- if (symbol->IsDummy() ||
+ if (IsDummy(*symbol) ||
(!symbol->GetType() && FindCommonBlockContaining(*symbol))) {
ConvertToObjectEntity(*symbol);
ApplyImplicitRules(*symbol);
ConvertToProcEntity(*symbol);
if (symbol->has<ProcEntityDetails>()) {
symbol->set(flag);
- if (symbol->IsDummy()) {
+ if (IsDummy(*symbol)) {
symbol->attrs().set(Attr::EXTERNAL);
}
ApplyImplicitRules(*symbol);
}
}
-const Symbol *Scope::GetSymbol() const {
- if (symbol_) {
- return symbol_;
- }
- if (derivedTypeSpec_) {
- return &derivedTypeSpec_->typeSymbol();
- }
- return nullptr;
-}
-
const Scope *Scope::GetDerivedTypeParent() const {
if (const Symbol * symbol{GetSymbol()}) {
if (const DerivedTypeSpec * parent{symbol->GetParentTypeSpec(this)}) {
}
}
-const Symbol &UseDetails::module() const {
- // owner is a module so it must have a symbol:
- return *symbol_->owner().symbol();
-}
-
UseErrorDetails::UseErrorDetails(const UseDetails &useDetails) {
- add_occurrence(useDetails.location(), *useDetails.module().scope());
+ add_occurrence(useDetails.location(), *GetUsedModule(useDetails).scope());
}
UseErrorDetails &UseErrorDetails::add_occurrence(
const SourceName &location, const Scope &module) {
details_);
}
-bool Symbol::IsDummy() const {
- return std::visit(
- common::visitors{[](const EntityDetails &x) { return x.isDummy(); },
- [](const ObjectEntityDetails &x) { return x.isDummy(); },
- [](const ProcEntityDetails &x) { return x.isDummy(); },
- [](const HostAssocDetails &x) { return x.symbol().IsDummy(); },
- [](const auto &) { return false; }},
- details_);
-}
-
bool Symbol::IsFuncResult() const {
return std::visit(
common::visitors{[](const EntityDetails &x) { return x.isFuncResult(); },
llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const Details &details) {
os << DetailsToString(details);
- std::visit(
+ std::visit( //
common::visitors{
[&](const UnknownDetails &) {},
[&](const MainProgramDetails &) {},
os << ' ' << EnumToString(x.kind());
},
[&](const UseDetails &x) {
- os << " from " << x.symbol().name() << " in " << x.module().name();
+ os << " from " << x.symbol().name() << " in "
+ << GetUsedModule(x).name();
},
[&](const UseErrorDetails &x) {
os << " uses:";
start, [](const Scope &scope) { return scope.IsModule(); });
}
-const Symbol *FindCommonBlockContaining(const Symbol &object) {
- if (const auto *details{object.detailsIf<ObjectEntityDetails>()}) {
- return details->commonBlock();
- } else {
- return nullptr;
- }
-}
-
const Scope *FindProgramUnitContaining(const Scope &start) {
return FindScopeContaining(start, [](const Scope &scope) {
switch (scope.kind()) {
DoesScopeContain(FindProgramUnitContaining(symbol), *subprogram);
}
-bool IsDummy(const Symbol &symbol) {
- if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
- return details->isDummy();
- } else if (const auto *details{symbol.detailsIf<ProcEntityDetails>()}) {
- return details->isDummy();
- } else {
- return false;
- }
-}
-
-bool IsStmtFunction(const Symbol &symbol) {
- const auto *subprogram{symbol.detailsIf<SubprogramDetails>()};
- return subprogram && subprogram->stmtFunction();
-}
-
bool IsInStmtFunction(const Symbol &symbol) {
if (const Symbol * function{symbol.owner().symbol()}) {
return IsStmtFunction(*function);
return IsPointer(symbol) && IsDummy(symbol);
}
-// variable-name
-bool IsVariableName(const Symbol &symbol) {
- if (const Symbol * root{GetAssociationRoot(symbol)}) {
- return root->has<ObjectEntityDetails>() && !IsNamedConstant(*root);
- } else {
- return false;
- }
-}
-
// proc-name
bool IsProcName(const Symbol &symbol) {
return symbol.GetUltimate().has<ProcEntityDetails>();
}
-bool IsFunction(const Symbol &symbol) {
- return std::visit(
- common::visitors{
- [](const SubprogramDetails &x) { return x.isFunction(); },
- [&](const SubprogramNameDetails &) {
- return symbol.test(Symbol::Flag::Function);
- },
- [](const ProcEntityDetails &x) {
- const auto &ifc{x.interface()};
- return ifc.type() || (ifc.symbol() && IsFunction(*ifc.symbol()));
- },
- [](const ProcBindingDetails &x) { return IsFunction(x.symbol()); },
- [](const UseDetails &x) { return IsFunction(x.symbol()); },
- [](const auto &) { return false; },
- },
- symbol.details());
-}
-
-bool IsPureProcedure(const Symbol &symbol) {
- if (const auto *procDetails{symbol.detailsIf<ProcEntityDetails>()}) {
- if (const Symbol * procInterface{procDetails->interface().symbol()}) {
- // procedure component with a pure interface
- return IsPureProcedure(*procInterface);
- }
- } else if (const auto *details{symbol.detailsIf<ProcBindingDetails>()}) {
- return IsPureProcedure(details->symbol());
- } else if (!IsProcedure(symbol)) {
- return false;
- }
- if (IsStmtFunction(symbol)) {
- // Section 15.7(1) states that a statement function is PURE if it does not
- // reference an IMPURE procedure or a VOLATILE variable
- const MaybeExpr &expr{symbol.get<SubprogramDetails>().stmtFunction()};
- if (expr) {
- for (const Symbol &refSymbol : evaluate::CollectSymbols(*expr)) {
- if (IsFunction(refSymbol) && !IsPureProcedure(refSymbol)) {
- return false;
- }
- if (const Symbol * root{GetAssociationRoot(refSymbol)}) {
- if (root->attrs().test(Attr::VOLATILE)) {
- return false;
- }
- }
- }
- }
- return true; // statement function was not found to be impure
- }
- return symbol.attrs().test(Attr::PURE) ||
- (symbol.attrs().test(Attr::ELEMENTAL) &&
- !symbol.attrs().test(Attr::IMPURE));
-}
-
-bool IsPureProcedure(const Scope &scope) {
- if (const Symbol * symbol{scope.GetSymbol()}) {
- return IsPureProcedure(*symbol);
- } else {
- return false;
- }
-}
-
bool IsBindCProcedure(const Symbol &symbol) {
if (const auto *procDetails{symbol.detailsIf<ProcEntityDetails>()}) {
if (const Symbol * procInterface{procDetails->interface().symbol()}) {
}
}
-bool IsProcedure(const Symbol &symbol) {
- return std::visit(
- common::visitors{
- [](const SubprogramDetails &) { return true; },
- [](const SubprogramNameDetails &) { return true; },
- [](const ProcEntityDetails &) { return true; },
- [](const GenericDetails &) { return true; },
- [](const ProcBindingDetails &) { return true; },
- [](const UseDetails &x) { return IsProcedure(x.symbol()); },
- // TODO: FinalProcDetails?
- [](const auto &) { return false; },
- },
- symbol.details());
-}
-
-bool IsProcedurePointer(const Symbol &symbol) {
- return symbol.has<ProcEntityDetails>() && IsPointer(symbol);
-}
-
static const Symbol *FindPointerComponent(
const Scope &scope, std::set<const Scope *> &visited) {
if (!scope.IsDerivedType()) {
return nullptr;
}
-// When a construct association maps to a variable, and that variable
-// is not an array with a vector-valued subscript, return the base
-// Symbol of that variable, else nullptr. Descends into other construct
-// associations when one associations maps to another.
-static const Symbol *GetAssociatedVariable(const AssocEntityDetails &details) {
- if (const MaybeExpr & expr{details.expr()}) {
- if (evaluate::IsVariable(*expr) && !evaluate::HasVectorSubscript(*expr)) {
- if (const Symbol * varSymbol{evaluate::GetFirstSymbol(*expr)}) {
- return GetAssociationRoot(*varSymbol);
- }
- }
- }
- return nullptr;
-}
-
-// Return the Symbol of the variable of a construct association, if it exists
-// Return nullptr if the name is associated with an expression
-const Symbol *GetAssociationRoot(const Symbol &symbol) {
- const Symbol &ultimate{symbol.GetUltimate()};
- if (const auto *details{ultimate.detailsIf<AssocEntityDetails>()}) {
- // We have a construct association
- return GetAssociatedVariable(*details);
- } else {
- return &ultimate;
- }
-}
-
bool IsExtensibleType(const DerivedTypeSpec *derived) {
return derived && !IsIsoCType(derived) &&
!derived->typeSymbol().attrs().test(Attr::BIND_C) &&
return false;
}
-bool IsSaved(const Symbol &symbol) {
- auto scopeKind{symbol.owner().kind()};
- if (scopeKind == Scope::Kind::Module || scopeKind == Scope::Kind::BlockData) {
- return true;
- } else if (scopeKind == Scope::Kind::DerivedType) {
- return false; // this is a component
- } else if (IsNamedConstant(symbol)) {
- return false;
- } else if (symbol.attrs().test(Attr::SAVE)) {
- return true;
- } else {
- if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
- if (object->init()) {
- return true;
- }
- } else if (IsProcedurePointer(symbol)) {
- if (symbol.get<ProcEntityDetails>().init()) {
- return true;
- }
- }
- if (const Symbol * block{FindCommonBlockContaining(symbol)}) {
- if (block->attrs().test(Attr::SAVE)) {
- return true;
- }
- }
- return false;
- }
-}
-
// Check this symbol suitable as a type-bound procedure - C769
bool CanBeTypeBoundProc(const Symbol *symbol) {
if (!symbol || IsDummy(*symbol) || IsProcedurePointer(*symbol)) {
CHECK(pair.second); // name was not already present
}
-int DerivedTypeSpec::NumLengthParameters() const {
- int result{0};
- for (const auto &pair : parameters_) {
- if (pair.second.isLen()) {
- ++result;
- }
- }
- return result;
-}
-
bool DerivedTypeSpec::MightBeParameterized() const {
return !cooked_ || !parameters_.empty();
}
return o;
}
-bool ArraySpec::IsExplicitShape() const {
- return CheckAll([](const ShapeSpec &x) { return x.ubound().isExplicit(); });
-}
-bool ArraySpec::IsAssumedShape() const {
- return CheckAll([](const ShapeSpec &x) { return x.ubound().isDeferred(); });
-}
-bool ArraySpec::IsDeferredShape() const {
- return CheckAll([](const ShapeSpec &x) {
- return x.lbound().isDeferred() && x.ubound().isDeferred();
- });
-}
-bool ArraySpec::IsImpliedShape() const {
- return !IsAssumedRank() &&
- CheckAll([](const ShapeSpec &x) { return x.ubound().isAssumed(); });
-}
-bool ArraySpec::IsAssumedSize() const {
- return !empty() && !IsAssumedRank() && back().ubound().isAssumed() &&
- std::all_of(begin(), end() - 1,
- [](const ShapeSpec &x) { return x.ubound().isExplicit(); });
-}
-bool ArraySpec::IsAssumedRank() const {
- return Rank() == 1 && front().lbound().isAssumed();
-}
-bool ArraySpec::IsConstantShape() const {
- return CheckAll([](const ShapeSpec &x) {
- const auto &lb{x.lbound().GetExplicit()};
- const auto &ub{x.ubound().GetExplicit()};
- return lb && ub && IsConstantExpr(*lb) && IsConstantExpr(*ub);
- });
-}
-
llvm::raw_ostream &operator<<(
llvm::raw_ostream &os, const ArraySpec &arraySpec) {
char sep{'('};
return false;
}
-IntrinsicTypeSpec *DeclTypeSpec::AsIntrinsic() {
- switch (category_) {
- case Numeric:
- return &std::get<NumericTypeSpec>(typeSpec_);
- case Logical:
- return &std::get<LogicalTypeSpec>(typeSpec_);
- case Character:
- return &std::get<CharacterTypeSpec>(typeSpec_);
- default:
- return nullptr;
- }
-}
-const IntrinsicTypeSpec *DeclTypeSpec::AsIntrinsic() const {
- return const_cast<DeclTypeSpec *>(this)->AsIntrinsic();
-}
-
-DerivedTypeSpec *DeclTypeSpec::AsDerived() {
- switch (category_) {
- case TypeDerived:
- case ClassDerived:
- return &std::get<DerivedTypeSpec>(typeSpec_);
- default:
- return nullptr;
- }
-}
-const DerivedTypeSpec *DeclTypeSpec::AsDerived() const {
- return const_cast<DeclTypeSpec *>(this)->AsDerived();
-}
-
const NumericTypeSpec &DeclTypeSpec::numericTypeSpec() const {
CHECK(category_ == Numeric);
return std::get<NumericTypeSpec>(typeSpec_);