[flang-commits] [flang] 0996b59 - [flang] Infrastructure improvements in utility routines
peter klausler via flang-commits
flang-commits at lists.llvm.org
Wed Jan 20 12:40:38 PST 2021
Author: peter klausler
Date: 2021-01-20T12:40:25-08:00
New Revision: 0996b590aaafe2de8378fd45a5094c13a4de3360
URL: https://github.com/llvm/llvm-project/commit/0996b590aaafe2de8378fd45a5094c13a4de3360
DIFF: https://github.com/llvm/llvm-project/commit/0996b590aaafe2de8378fd45a5094c13a4de3360.diff
LOG: [flang] Infrastructure improvements in utility routines
* IsArrayElement() needs another option to control whether it
should ignore trailing component references.
* Add IsObjectPointer().
* Add const Scope& variants of IsFunction() and IsProcedure().
* Make TypeAndShape::Characterize() work with procedure bindings.
* Handle CHARACTER length in MeasureSizeInBytes().
* Fine-tune FindExternallyVisibleObject()'s handling of dummy arguments
to conform with Fortran 2018: only INTENT(IN) and dummy pointers
in pure functions signify; update two tests accordingly.
Also: resolve some stylistic inconsistencies and add a missing
"const" in the expression traversal template framework.
Differential Revision: https://reviews.llvm.org/D95011
Added:
Modified:
flang/include/flang/Evaluate/call.h
flang/include/flang/Evaluate/tools.h
flang/include/flang/Evaluate/traverse.h
flang/lib/Evaluate/characteristics.cpp
flang/lib/Evaluate/tools.cpp
flang/lib/Semantics/tools.cpp
flang/test/Semantics/structconst03.f90
flang/test/Semantics/structconst04.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h
index 0e78839b2ccc..e74e82d86f87 100644
--- a/flang/include/flang/Evaluate/call.h
+++ b/flang/include/flang/Evaluate/call.h
@@ -111,12 +111,18 @@ class ActualArgument {
llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
std::optional<parser::CharBlock> keyword() const { return keyword_; }
- void set_keyword(parser::CharBlock x) { keyword_ = x; }
+ ActualArgument &set_keyword(parser::CharBlock x) {
+ keyword_ = x;
+ return *this;
+ }
bool isAlternateReturn() const {
return std::holds_alternative<common::Label>(u_);
}
bool isPassedObject() const { return isPassedObject_; }
- void set_isPassedObject(bool yes = true) { isPassedObject_ = yes; }
+ ActualArgument &set_isPassedObject(bool yes = true) {
+ isPassedObject_ = yes;
+ return *this;
+ }
bool Matches(const characteristics::DummyArgument &) const;
common::Intent dummyIntent() const { return dummyIntent_; }
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index 3fe3dc1843ec..351dc8715cdd 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -235,11 +235,14 @@ std::optional<DataRef> ExtractSubstringBase(const Substring &);
// Predicate: is an expression is an array element reference?
template <typename T>
-bool IsArrayElement(const Expr<T> &expr, bool intoSubstring = false) {
+bool IsArrayElement(const Expr<T> &expr, bool intoSubstring = true,
+ bool skipComponents = false) {
if (auto dataRef{ExtractDataRef(expr, intoSubstring)}) {
const DataRef *ref{&*dataRef};
- while (const Component * component{std::get_if<Component>(&ref->u)}) {
- ref = &component->base();
+ if (skipComponents) {
+ while (const Component * component{std::get_if<Component>(&ref->u)}) {
+ ref = &component->base();
+ }
}
if (const auto *coarrayRef{std::get_if<CoarrayRef>(&ref->u)}) {
return !coarrayRef->subscript().empty();
@@ -789,6 +792,7 @@ bool IsProcedure(const Expr<SomeType> &);
bool IsFunction(const Expr<SomeType> &);
bool IsProcedurePointer(const Expr<SomeType> &);
bool IsNullPointer(const Expr<SomeType> &);
+bool IsObjectPointer(const Expr<SomeType> &, FoldingContext &);
// Extracts the chain of symbols from a designator, which has perhaps been
// wrapped in an Expr<>, removing all of the (co)subscripts. The
@@ -913,12 +917,13 @@ 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.
// All of these apply GetUltimate() or ResolveAssociations() to their arguments.
-
bool IsVariableName(const Symbol &);
bool IsPureProcedure(const Symbol &);
bool IsPureProcedure(const Scope &);
bool IsFunction(const Symbol &);
+bool IsFunction(const Scope &);
bool IsProcedure(const Symbol &);
+bool IsProcedure(const Scope &);
bool IsProcedurePointer(const Symbol &);
bool IsSaved(const Symbol &); // saved implicitly or explicitly
bool IsDummy(const Symbol &);
diff --git a/flang/include/flang/Evaluate/traverse.h b/flang/include/flang/Evaluate/traverse.h
index 9238e58a1fb3..c9455910aa41 100644
--- a/flang/include/flang/Evaluate/traverse.h
+++ b/flang/include/flang/Evaluate/traverse.h
@@ -50,7 +50,7 @@ template <typename Visitor, typename Result> class Traverse {
Result operator()(const common::Indirection<A, C> &x) const {
return visitor_(x.value());
}
- template <typename A> Result operator()(SymbolRef x) const {
+ template <typename A> Result operator()(const SymbolRef x) const {
return visitor_(*x);
}
template <typename A> Result operator()(const std::unique_ptr<A> &x) const {
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 3af3808ab0ff..92ecdd6fe153 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -100,6 +100,9 @@ std::optional<TypeAndShape> TypeAndShape::Characterize(
[&](const semantics::AssocEntityDetails &assoc) {
return Characterize(assoc, context);
},
+ [&](const semantics::ProcBindingDetails &binding) {
+ return Characterize(binding.symbol(), context);
+ },
[](const auto &) { return std::optional<TypeAndShape>{}; },
},
// GetUltimate() used here, not ResolveAssociations(), because
@@ -178,6 +181,12 @@ std::optional<Expr<SubscriptInteger>> TypeAndShape::MeasureSizeInBytes(
if (auto elements{GetSize(Shape{shape_})}) {
// Sizes of arrays (even with single elements) are multiples of
// their alignments.
+ if (LEN_) {
+ CHECK(type_.category() == TypeCategory::Character);
+ return Fold(foldingContext,
+ std::move(*elements) * Expr<SubscriptInteger>{type_.kind()} *
+ Expr<SubscriptInteger>{*LEN_});
+ }
if (auto elementBytes{
type_.MeasureSizeInBytes(foldingContext, GetRank(shape_) > 0)}) {
return Fold(
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 2b04ed8a6550..d06463e39de7 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -66,7 +66,7 @@ auto IsVariableHelper::operator()(const Substring &x) const -> Result {
auto IsVariableHelper::operator()(const ProcedureDesignator &x) const
-> Result {
const Symbol *symbol{x.GetSymbol()};
- return symbol && symbol->attrs().test(semantics::Attr::POINTER);
+ return symbol && IsPointer(*symbol);
}
// Conversions of COMPLEX component expressions to REAL.
@@ -696,6 +696,40 @@ bool IsProcedurePointer(const Expr<SomeType> &expr) {
expr.u);
}
+template <typename A> inline const ProcedureRef *UnwrapProcedureRef(const A &) {
+ return nullptr;
+}
+
+template <typename T>
+inline const ProcedureRef *UnwrapProcedureRef(const FunctionRef<T> &func) {
+ return &func;
+}
+
+template <typename T>
+inline const ProcedureRef *UnwrapProcedureRef(const Expr<T> &expr) {
+ return std::visit(
+ [](const auto &x) { return UnwrapProcedureRef(x); }, expr.u);
+}
+
+// IsObjectPointer()
+bool IsObjectPointer(const Expr<SomeType> &expr, FoldingContext &context) {
+ if (IsNullPointer(expr)) {
+ return true;
+ } else if (IsProcedurePointer(expr)) {
+ return false;
+ } else if (const auto *procRef{UnwrapProcedureRef(expr)}) {
+ auto proc{
+ characteristics::Procedure::Characterize(procRef->proc(), context)};
+ return proc && proc->functionResult &&
+ proc->functionResult->attrs.test(
+ characteristics::FunctionResult::Attr::Pointer);
+ } else if (const Symbol * symbol{GetLastSymbol(expr)}) {
+ return IsPointer(symbol->GetUltimate());
+ } else {
+ return false;
+ }
+}
+
// IsNullPointer()
struct IsNullPointerHelper : public AllTraverse<IsNullPointerHelper, false> {
using Base = AllTraverse<IsNullPointerHelper, false>;
@@ -1026,6 +1060,11 @@ bool IsFunction(const Symbol &symbol) {
symbol.GetUltimate().details());
}
+bool IsFunction(const Scope &scope) {
+ const Symbol *symbol{scope.GetSymbol()};
+ return symbol && IsFunction(*symbol);
+}
+
bool IsProcedure(const Symbol &symbol) {
return std::visit(common::visitors{
[](const SubprogramDetails &) { return true; },
@@ -1038,8 +1077,14 @@ bool IsProcedure(const Symbol &symbol) {
symbol.GetUltimate().details());
}
-const Symbol *FindCommonBlockContaining(const Symbol &object) {
- const auto *details{object.detailsIf<ObjectEntityDetails>()};
+bool IsProcedure(const Scope &scope) {
+ const Symbol *symbol{scope.GetSymbol()};
+ return symbol && IsProcedure(*symbol);
+}
+
+const Symbol *FindCommonBlockContaining(const Symbol &original) {
+ const Symbol &root{GetAssociationRoot(original)};
+ const auto *details{root.detailsIf<ObjectEntityDetails>()};
return details ? details->commonBlock() : nullptr;
}
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index f7d3c20de2a0..10ef54e98f19 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -330,15 +330,22 @@ const Symbol *FindExternallyVisibleObject(
const Symbol &object, const Scope &scope) {
// TODO: Storage association with any object for which this predicate holds,
// once EQUIVALENCE is supported.
- if (IsUseAssociated(object, scope) || IsHostAssociated(object, scope) ||
- (IsPureProcedure(scope) && IsPointerDummy(object)) ||
- (IsIntentIn(object) && IsDummy(object))) {
+ const Symbol &ultimate{GetAssociationRoot(object)};
+ if (IsDummy(ultimate)) {
+ if (IsIntentIn(ultimate)) {
+ return &ultimate;
+ }
+ if (IsPointer(ultimate) && IsPureProcedure(ultimate.owner()) &&
+ IsFunction(ultimate.owner())) {
+ return &ultimate;
+ }
+ } else if (&GetProgramUnitContaining(ultimate) !=
+ &GetProgramUnitContaining(scope)) {
return &object;
- } else if (const Symbol * block{FindCommonBlockContaining(object)}) {
+ } else if (const Symbol * block{FindCommonBlockContaining(ultimate)}) {
return block;
- } else {
- return nullptr;
}
+ return nullptr;
}
bool ExprHasTypeCategory(
diff --git a/flang/test/Semantics/structconst03.f90 b/flang/test/Semantics/structconst03.f90
index dbf53e11c619..f98f05c1a21a 100644
--- a/flang/test/Semantics/structconst03.f90
+++ b/flang/test/Semantics/structconst03.f90
@@ -71,7 +71,6 @@ pure subroutine ps1(dummy1, dummy2, dummy3, dummy4)
!ERROR: Externally visible object 'dummy1' may not be associated with pointer component 'pt1' in a pure procedure
x1 = t1(0)(dummy1)
x1 = t1(0)(dummy2)
- !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
x1 = t1(0)(dummy3)
! TODO when semantics handles coindexing:
! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure
@@ -106,9 +105,7 @@ pure subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a)
!ERROR: Externally visible object 'dummy1a' may not be associated with pointer component 'pt1' in a pure procedure
x1a = t1(0)(dummy1a)
x1a = t1(0)(dummy2a)
- !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
x1a = t1(0)(dummy3)
- !ERROR: Externally visible object 'dummy3a' may not be associated with pointer component 'pt1' in a pure procedure
x1a = t1(0)(dummy3a)
! TODO when semantics handles coindexing:
! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure
@@ -123,6 +120,22 @@ pure subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a)
end subroutine subr
end subroutine
+ pure integer function pf1(dummy3)
+ real, pointer :: dummy3
+ type(t1(0)) :: x1
+ pf1 = 0
+ !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
+ x1 = t1(0)(dummy3)
+ contains
+ pure subroutine subr(dummy3a)
+ real, pointer :: dummy3a
+ type(t1(0)) :: x1a
+ !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
+ x1a = t1(0)(dummy3)
+ x1a = t1(0)(dummy3a)
+ end subroutine
+ end function
+
impure real function ipf1(dummy1, dummy2, dummy3, dummy4)
real, target :: local1
type(t1(0)) :: x1
diff --git a/flang/test/Semantics/structconst04.f90 b/flang/test/Semantics/structconst04.f90
index c5bc2d3e6bf3..57001f23df9e 100644
--- a/flang/test/Semantics/structconst04.f90
+++ b/flang/test/Semantics/structconst04.f90
@@ -66,7 +66,6 @@ pure subroutine ps1(dummy1, dummy2, dummy3, dummy4)
!ERROR: Externally visible object 'dummy1' may not be associated with pointer component 'pt1' in a pure procedure
x1 = t1(dummy1)
x1 = t1(dummy2)
- !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
x1 = t1(dummy3)
! TODO when semantics handles coindexing:
! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure
@@ -101,9 +100,7 @@ pure subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a)
!ERROR: Externally visible object 'dummy1a' may not be associated with pointer component 'pt1' in a pure procedure
x1a = t1(dummy1a)
x1a = t1(dummy2a)
- !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
x1a = t1(dummy3)
- !ERROR: Externally visible object 'dummy3a' may not be associated with pointer component 'pt1' in a pure procedure
x1a = t1(dummy3a)
! TODO when semantics handles coindexing:
! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure
@@ -118,6 +115,21 @@ pure subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a)
end subroutine subr
end subroutine
+ pure integer function pf1(dummy3)
+ real, pointer :: dummy3
+ type(t1) :: x1
+ !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
+ x1 = t1(dummy3)
+ contains
+ pure subroutine subr(dummy3a)
+ real, pointer :: dummy3a
+ type(t1) :: x1a
+ !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
+ x1a = t1(dummy3)
+ x1a = t1(dummy3a)
+ end subroutine
+ end function
+
impure real function ipf1(dummy1, dummy2, dummy3, dummy4)
real, target :: local1
type(t1) :: x1
More information about the flang-commits
mailing list