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

[flang] Use component iterators in check-call.cc 

Original-commit: flang-compiler/f18@e78db8907f
Reviewed-on: https://github.com/flang-compiler/f18/pull/782
This commit is contained in:
peter klausler 2019-10-17 15:29:26 -07:00
parent 5f8817bdac
commit 15f38e2d67
6 changed files with 97 additions and 115 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

71
flang/lib/semantics/check-call.cc
View File

@ -13,7 +13,6 @@
// limitations under the License.
#include "check-call.h"
#include "check-declarations.h"
#include "scope.h"
#include "tools.h"
#include "../evaluate/characteristics.h"
@ -152,48 +151,64 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
if (!actualType.type().IsUnlimitedPolymorphic() &&
actualType.type().category() == TypeCategory::Derived) {
const auto &derived{actualType.type().GetDerivedTypeSpec()};
TypeInspector inspector;
inspector.Inspect(derived);
if (dummy.type.type().IsAssumedType()) {
if (!derived.parameters().empty()) { // 15.5.2.4(2)
messages.Say(
"Actual argument associated with TYPE(*) %s may not have a parameterized derived type"_err_en_US,
dummyName);
}
if (inspector.typeBoundProcedure()) { // 15.5.2.4(2)
if (const Symbol *
tbp{FindImmediateComponent(derived,
std::function<bool(const Symbol &)>{[](const Symbol &symbol) {
return symbol.has<ProcBindingDetails>();
}})}) { // 15.5.2.4(2)
if (auto *msg{messages.Say(
"Actual argument associated with TYPE(*) %s may not have type-bound procedures"_err_en_US,
dummyName)}) {
msg->Attach(inspector.typeBoundProcedure()->name(),
"Declaration of type-bound procedure"_en_US);
"Actual argument associated with TYPE(*) %s may not have type-bound procedure '%s'"_err_en_US,
dummyName, tbp->name())}) {
msg->Attach(tbp->name(), "Declaration of type-bound procedure"_en_US);
}
}
if (inspector.finalProcedure()) { // 15.5.2.4(2)
if (const Symbol *
finalizer{FindImmediateComponent(derived,
std::function<bool(const Symbol &)>{[](const Symbol &symbol) {
return symbol.has<FinalProcDetails>();
}})}) { // 15.5.2.4(2)
if (auto *msg{messages.Say(
"Actual argument associated with TYPE(*) %s may not have FINAL procedures"_err_en_US,
dummyName)}) {
msg->Attach(inspector.finalProcedure()->name(),
"Declaration of FINAL procedure"_en_US);
"Actual argument associated with TYPE(*) %s may not have FINAL subroutine '%s'"_err_en_US,
dummyName, finalizer->name())}) {
msg->Attach(
finalizer->name(), "Declaration of FINAL subroutine"_en_US);
}
}
}
if (actualIsCoindexed && inspector.allocatable() &&
dummy.intent != common::Intent::In && !dummyIsValue) {
// 15.5.2.4(6)
if (auto *msg{messages.Say(
"Coindexed actual argument with ALLOCATABLE ultimate component must be associated with a %s with VALUE or INTENT(IN) attributes"_err_en_US,
dummyName)}) {
msg->Attach(inspector.allocatable()->name(),
"Declaration of ALLOCATABLE component"_en_US);
UltimateComponentIterator ultimates{derived};
if (actualIsCoindexed && dummy.intent != common::Intent::In &&
!dummyIsValue) {
if (auto iter{std::find_if(
ultimates.begin(), ultimates.end(), [](const Symbol *component) {
return DEREF(component).attrs().test(Attr::ALLOCATABLE);
})}) { // 15.5.2.4(6)
if (auto *msg{messages.Say(
"Coindexed actual argument with ALLOCATABLE ultimate component '%s' must be associated with a %s with VALUE or INTENT(IN) attributes"_err_en_US,
iter.BuildResultDesignatorName(), dummyName)}) {
msg->Attach(
(*iter)->name(), "Declaration of ALLOCATABLE component"_en_US);
}
}
}
if (inspector.coarray() &&
actualIsVolatile != dummyIsVolatile) { // 15.5.2.4(22)
if (auto *msg{messages.Say(
"VOLATILE attribute must match for %s when actual argument has a coarray ultimate component"_err_en_US,
dummyName)}) {
msg->Attach(inspector.coarray()->name(),
"Declaration of coarray component"_en_US);
if (actualIsVolatile != dummyIsVolatile) { // 15.5.2.4(22)
if (auto iter{std::find_if(
ultimates.begin(), ultimates.end(), [](const Symbol *component) {
const auto *object{
DEREF(component).detailsIf<ObjectEntityDetails>()};
return object && object->IsCoarray();
})}) {
if (auto *msg{messages.Say(
"VOLATILE attribute must match for %s when actual argument has a coarray ultimate component '%s'"_err_en_US,
dummyName, iter.BuildResultDesignatorName())}) {
msg->Attach(
(*iter)->name(), "Declaration of coarray component"_en_US);
}
}
}
}

47
flang/lib/semantics/check-declarations.cc
View File

@ -119,51 +119,4 @@ void CheckHelper::Check(Symbol &symbol) {
void CheckDeclarations(SemanticsContext &context) {
CheckHelper{context}.Check();
}
TypeInspector::TypeInspector() {}
TypeInspector::~TypeInspector() {}
void TypeInspector::Inspect(const DerivedTypeSpec &derived) {
Inspect(derived, true);
}
void TypeInspector::Inspect(
const DerivedTypeSpec &derived, bool inParentChain) {
if (inspected_.insert(&derived).second) {
if (const auto *parent{
derived.typeSymbol().GetParentTypeSpec(derived.scope())}) {
Inspect(*parent, inParentChain);
}
if (const auto *scope{derived.typeSymbol().scope()}) {
for (const auto &pair : *scope) {
Inspect(*pair.second, inParentChain);
}
}
}
}
void TypeInspector::Inspect(const Symbol &component, bool inParentChain) {
if (const auto *object{component.detailsIf<ObjectEntityDetails>()}) {
if (component.attrs().test(Attr::ALLOCATABLE)) {
allocatable_ = &component;
}
if (object->IsCoarray()) {
coarray_ = &component;
if (component.attrs().test(Attr::ALLOCATABLE)) {
allocatableCoarray_ = &component;
}
}
if (const auto *type{object->type()}) {
if (const auto *nested{type->AsDerived()}) {
Inspect(*nested, false);
}
}
} else if (inParentChain) {
if (component.has<ProcBindingDetails>()) {
typeBoundProcedure_ = &component;
} else if (component.has<FinalProcDetails>()) {
finalProcedure_ = &component;
}
}
}
}

29
flang/lib/semantics/check-declarations.h
View File

@ -16,37 +16,8 @@
#ifndef FORTRAN_SEMANTICS_CHECK_DECLARATIONS_H_
#define FORTRAN_SEMANTICS_CHECK_DECLARATIONS_H_
#include <set>
namespace Fortran::semantics {
class DerivedTypeSpec;
class SemanticsContext;
class Symbol;
void CheckDeclarations(SemanticsContext &);
class TypeInspector {
public:
TypeInspector();
~TypeInspector();
const Symbol *typeBoundProcedure() const { return typeBoundProcedure_; }
const Symbol *finalProcedure() const { return finalProcedure_; }
const Symbol *allocatable() const { return allocatable_; }
const Symbol *coarray() const { return coarray_; }
const Symbol *allocatableCoarray() const { return allocatableCoarray_; }
void Inspect(const DerivedTypeSpec &);
private:
void Inspect(const DerivedTypeSpec &, bool inParentChain);
void Inspect(const Symbol &, bool inParentChain);
const Symbol *typeBoundProcedure_{nullptr};
const Symbol *finalProcedure_{nullptr};
const Symbol *allocatable_{nullptr};
const Symbol *coarray_{nullptr};
const Symbol *allocatableCoarray_{nullptr};
std::set<const DerivedTypeSpec *> inspected_;
};
}
#endif

28
flang/lib/semantics/tools.cc
View File

@ -831,7 +831,6 @@ ComponentIterator<componentKind>::const_iterator::Create(
template<ComponentKind componentKind>
bool ComponentIterator<componentKind>::const_iterator::PlanComponentTraversal(
const Symbol &component) {
// only data component can be traversed
if (const auto *details{component.detailsIf<ObjectEntityDetails>()}) {
const DeclTypeSpec *type{details->type()};
if (!type) {
@ -1023,6 +1022,33 @@ const Symbol *FindUltimateComponent(const DerivedTypeSpec &derived,
return nullptr;
}
const Symbol *FindImmediateComponent(const DerivedTypeSpec &type,
const std::function<bool(const Symbol &)> &predicate) {
if (const Scope * scope{type.scope()}) {
const Symbol *parent{nullptr};
for (const auto &pair : *scope) {
if (const Symbol * symbol{pair.second}) {
if (predicate(*symbol)) {
return symbol;
}
if (symbol->test(Symbol::Flag::ParentComp)) {
parent = symbol;
}
}
}
if (parent != nullptr) {
if (const auto *object{parent->detailsIf<ObjectEntityDetails>()}) {
if (const auto *type{object->type()}) {
if (const auto *derived{type->AsDerived()}) {
return FindImmediateComponent(*derived, predicate);
}
}
}
}
}
return nullptr;
}
bool IsFunctionResult(const Symbol &symbol) {
return (symbol.has<semantics::ObjectEntityDetails>() &&
symbol.get<semantics::ObjectEntityDetails>().isFuncResult()) ||

27
flang/lib/semantics/tools.h
View File

@ -84,6 +84,10 @@ bool CanBeTypeBoundProc(const Symbol *);
const Symbol *FindUltimateComponent(
const DerivedTypeSpec &type, std::function<bool(const Symbol &)> predicate);
// Returns an immediate component of type that matches predicate, or nullptr.
const Symbol *FindImmediateComponent(
const DerivedTypeSpec &, const std::function<bool(const Symbol &)> &);
inline bool IsPointer(const Symbol &symbol) {
return symbol.attrs().test(Attr::POINTER);
}
@ -213,7 +217,7 @@ template<typename T> std::optional<std::int64_t> GetIntValue(const T &x) {
// Derived type component iterator that provides a C++ LegacyForwardIterator
// iterator over the Ordered, Direct, Ultimate or Potential components of a
// DerivedTypeSpec. These iterators can be used with STL algorithms
// accepting LegacyForwadIterator.
// accepting LegacyForwardIterator.
// The kind of component is a template argument of the iterator factory
// ComponentIterator.
//
@ -229,6 +233,18 @@ template<typename T> std::optional<std::int64_t> GetIntValue(const T &x) {
// - then, the components in declaration order (without visiting subcomponents)
//
// - Ultimate, Direct and Potential components are as defined in 7.5.1.
// - Ultimate components of a derived type are the closure of its components
// of intrinsic type, its ALLOCATABLE or POINTER components, and the
// ultimate components of its non-ALLOCATABLE non-POINTER derived type
// components. (No ultimate component has a derived type unless it is
// ALLOCATABLE or POINTER.)
// - Direct components of a derived type are all of its components, and all
// of the direct components of its non-ALLOCATABLE non-POINTER derived type
// components. (Direct components are always present.)
// - Potential subobject components of a derived type are the closure of
// its non-POINTER components and the potential subobject components of
// its non-POINTER derived type components. (The lifetime of each
// potential subobject component is that of the entire instance.)
// Parent and procedure components are considered against these definitions.
// For this kind of iterator, the component tree is recursively visited in the
// following order:
@ -302,11 +318,11 @@ public:
GetComponentSymbol(componentPath_.back());
}
// Build a designator name of the referenced component for messages.
// Builds a designator name of the referenced component for messages.
// The designator helps when the component referred to by the iterator
// may be "buried" into other components. This gives the full
// path inside the iterated derived type: e.g "%a%b%c%ultimate"
// when (*it)->names() only gives "ultimate". Parent component are
// when (*it)->name() only gives "ultimate". Parent components are
// part of the path for clarity, even though they could be
// skipped.
std::string BuildResultDesignatorName() const;
@ -358,8 +374,8 @@ using PotentialComponentIterator = ComponentIterator<ComponentKind::Potential>;
// Common component searches, the iterator returned is referring to the first
// component, according to the order defined for the related ComponentIterator,
// that verifies the property from the name.
// If no components verifies the property, an end iterator (casting to false)
// is returned. Otherwise, the returned iterator cast to true and can be
// If no component verifies the property, an end iterator (casting to false)
// is returned. Otherwise, the returned iterator casts to true and can be
// dereferenced.
PotentialComponentIterator::const_iterator FindEventOrLockPotentialComponent(
const DerivedTypeSpec &);
@ -367,5 +383,6 @@ UltimateComponentIterator::const_iterator FindCoarrayUltimateComponent(
const DerivedTypeSpec &);
UltimateComponentIterator::const_iterator FindPointerUltimateComponent(
const DerivedTypeSpec &);
}
#endif // FORTRAN_SEMANTICS_TOOLS_H_

10
flang/test/semantics/call03.f90
View File

@ -120,13 +120,13 @@ module m01
subroutine test04 ! 15.5.2.4(2)
type(tbp) :: x
!ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have type-bound procedures
!ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have type-bound procedure 'binding'
call typestar(x)
end subroutine
subroutine test05 ! 15.5.2.4(2)
type(final) :: x
!ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have FINAL procedures
!ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have FINAL subroutine 'subr02'
call typestar(x)
end subroutine
@ -145,7 +145,7 @@ module m01
end subroutine
subroutine test07(x) ! 15.5.2.4(6)
type(alloc) :: x[*]
!ERROR: Coindexed actual argument with ALLOCATABLE ultimate component must be associated with a dummy argument 'x=' with VALUE or INTENT(IN) attributes
!ERROR: Coindexed actual argument with ALLOCATABLE ultimate component '%a' must be associated with a dummy argument 'x=' with VALUE or INTENT(IN) attributes
call out01(x[1])
end subroutine
@ -238,9 +238,9 @@ module m01
type(ultimateCoarray), volatile :: b
call coarr(a) ! ok
call volcoarr(b) ! ok
!ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component
!ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component '%a'
call coarr(b)
!ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component
!ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component '%a'
call volcoarr(a)
end subroutine