-
Notifications
You must be signed in to change notification settings - Fork 14.9k
[flang] Consolidate copy-in/copy-out determination in evaluate framework #155810
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
base: release/21.x
Are you sure you want to change the base?
[flang] Consolidate copy-in/copy-out determination in evaluate framework #155810
Conversation
Backport of llvm#151408 New implementation of `MayNeedCopy()` is used to consolidate copy-in/copy-out checks. `IsAssumedShape()` and `IsAssumedRank()` were simplified and are both now in `Fortran::semantics` workspace. `preparePresentUserCallActualArgument()` in lowering was modified to use `MayNeedCopyInOut()` Fixes llvm#138471 Conflicts in backport were trivial. Remove modifications of new code not present in 21.x branch: flang/lib/Semantics/check-omp-structure.cpp flang/lib/Semantics/resolve-directives.cpp
@llvm/pr-subscribers-flang-fir-hlfir Author: Tom Eccles (tblah) ChangesBackport of #151408 New implementation of
Fixes #138471 Conflicts in backport were trivial. Remove modifications of new code not present in 21.x branch: Patch is 42.18 KiB, truncated to 20.00 KiB below, full version: https://github.com/llvm/llvm-project/pull/155810.diff 22 Files Affected:
diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index d566c34ff71e8..b6a9ebefec9df 100644
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -203,6 +203,12 @@ class TypeAndShape {
std::optional<Expr<SubscriptInteger>> MeasureSizeInBytes(
FoldingContext &) const;
+ bool IsExplicitShape() const {
+ // If it's array and no special attributes are set, then must be
+ // explicit shape.
+ return Rank() > 0 && attrs_.none();
+ }
+
// called by Fold() to rewrite in place
TypeAndShape &Rewrite(FoldingContext &);
diff --git a/flang/include/flang/Evaluate/check-expression.h b/flang/include/flang/Evaluate/check-expression.h
index 0cf12f340ec5c..9a0885f4d0996 100644
--- a/flang/include/flang/Evaluate/check-expression.h
+++ b/flang/include/flang/Evaluate/check-expression.h
@@ -118,6 +118,9 @@ std::optional<bool> IsContiguous(const A &, FoldingContext &,
extern template std::optional<bool> IsContiguous(const Expr<SomeType> &,
FoldingContext &, bool namedConstantSectionsAreContiguous,
bool firstDimensionStride1);
+extern template std::optional<bool> IsContiguous(const ActualArgument &,
+ FoldingContext &, bool namedConstantSectionsAreContiguous,
+ bool firstDimensionStride1);
extern template std::optional<bool> IsContiguous(const ArrayRef &,
FoldingContext &, bool namedConstantSectionsAreContiguous,
bool firstDimensionStride1);
@@ -153,5 +156,8 @@ extern template bool IsErrorExpr(const Expr<SomeType> &);
std::optional<parser::Message> CheckStatementFunction(
const Symbol &, const Expr<SomeType> &, FoldingContext &);
+bool MayNeedCopy(const ActualArgument *, const characteristics::DummyArgument *,
+ FoldingContext &, bool forCopyOut);
+
} // namespace Fortran::evaluate
#endif
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index 96ed86f468350..55f23fbdcbb70 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -81,27 +81,6 @@ template <typename A> bool IsVariable(const A &x) {
}
}
-// Predicate: true when an expression is assumed-rank
-bool IsAssumedRank(const Symbol &);
-bool IsAssumedRank(const ActualArgument &);
-template <typename A> bool IsAssumedRank(const A &) { return false; }
-template <typename A> bool IsAssumedRank(const Designator<A> &designator) {
- if (const auto *symbol{std::get_if<SymbolRef>(&designator.u)}) {
- return IsAssumedRank(symbol->get());
- } else {
- return false;
- }
-}
-template <typename T> bool IsAssumedRank(const Expr<T> &expr) {
- return common::visit([](const auto &x) { return IsAssumedRank(x); }, expr.u);
-}
-template <typename A> bool IsAssumedRank(const std::optional<A> &x) {
- return x && IsAssumedRank(*x);
-}
-template <typename A> bool IsAssumedRank(const A *x) {
- return x && IsAssumedRank(*x);
-}
-
// Finds the corank of an entity, possibly packaged in various ways.
// Unlike rank, only data references have corank > 0.
int GetCorank(const ActualArgument &);
@@ -1122,6 +1101,7 @@ extern template semantics::UnorderedSymbolSet CollectCudaSymbols(
// Predicate: does a variable contain a vector-valued subscript (not a triplet)?
bool HasVectorSubscript(const Expr<SomeType> &);
+bool HasVectorSubscript(const ActualArgument &);
// Predicate: does an expression contain constant?
bool HasConstant(const Expr<SomeType> &);
@@ -1548,7 +1528,19 @@ bool IsAllocatableOrObjectPointer(const Symbol *);
bool IsAutomatic(const Symbol &);
bool IsSaved(const Symbol &); // saved implicitly or explicitly
bool IsDummy(const Symbol &);
+
+bool IsAssumedRank(const Symbol &);
+template <typename A> bool IsAssumedRank(const A &x) {
+ auto *symbol{UnwrapWholeSymbolDataRef(x)};
+ return symbol && IsAssumedRank(*symbol);
+}
+
bool IsAssumedShape(const Symbol &);
+template <typename A> bool IsAssumedShape(const A &x) {
+ auto *symbol{UnwrapWholeSymbolDataRef(x)};
+ return symbol && IsAssumedShape(*symbol);
+}
+
bool IsDeferredShape(const Symbol &);
bool IsFunctionResult(const Symbol &);
bool IsKindTypeParameter(const Symbol &);
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 3d7f01d56c465..aae92933e42d8 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -917,8 +917,8 @@ class IsContiguousHelper
} else {
return Base::operator()(ultimate); // use expr
}
- } else if (semantics::IsPointer(ultimate) ||
- semantics::IsAssumedShape(ultimate) || IsAssumedRank(ultimate)) {
+ } else if (semantics::IsPointer(ultimate) || IsAssumedShape(ultimate) ||
+ IsAssumedRank(ultimate)) {
return std::nullopt;
} else if (ultimate.has<semantics::ObjectEntityDetails>()) {
return true;
@@ -1198,9 +1198,21 @@ std::optional<bool> IsContiguous(const A &x, FoldingContext &context,
}
}
+std::optional<bool> IsContiguous(const ActualArgument &actual,
+ FoldingContext &fc, bool namedConstantSectionsAreContiguous,
+ bool firstDimensionStride1) {
+ auto *expr{actual.UnwrapExpr()};
+ return expr &&
+ IsContiguous(
+ *expr, fc, namedConstantSectionsAreContiguous, firstDimensionStride1);
+}
+
template std::optional<bool> IsContiguous(const Expr<SomeType> &,
FoldingContext &, bool namedConstantSectionsAreContiguous,
bool firstDimensionStride1);
+template std::optional<bool> IsContiguous(const ActualArgument &,
+ FoldingContext &, bool namedConstantSectionsAreContiguous,
+ bool firstDimensionStride1);
template std::optional<bool> IsContiguous(const ArrayRef &, FoldingContext &,
bool namedConstantSectionsAreContiguous, bool firstDimensionStride1);
template std::optional<bool> IsContiguous(const Substring &, FoldingContext &,
@@ -1350,4 +1362,177 @@ std::optional<parser::Message> CheckStatementFunction(
return StmtFunctionChecker{sf, context}(expr);
}
+// Helper class for checking differences between actual and dummy arguments
+class CopyInOutExplicitInterface {
+public:
+ explicit CopyInOutExplicitInterface(FoldingContext &fc,
+ const ActualArgument &actual,
+ const characteristics::DummyDataObject &dummyObj)
+ : fc_{fc}, actual_{actual}, dummyObj_{dummyObj} {}
+
+ // Returns true, if actual and dummy have different contiguity requirements
+ bool HaveContiguityDifferences() const {
+ // Check actual contiguity, unless dummy doesn't care
+ bool dummyTreatAsArray{dummyObj_.ignoreTKR.test(common::IgnoreTKR::Rank)};
+ bool actualTreatAsContiguous{
+ dummyObj_.ignoreTKR.test(common::IgnoreTKR::Contiguous) ||
+ IsSimplyContiguous(actual_, fc_)};
+ bool dummyIsExplicitShape{dummyObj_.type.IsExplicitShape()};
+ bool dummyIsAssumedSize{dummyObj_.type.attrs().test(
+ characteristics::TypeAndShape::Attr::AssumedSize)};
+ bool dummyIsPolymorphic{dummyObj_.type.type().IsPolymorphic()};
+ // type(*) with IGNORE_TKR(tkr) is often used to interface with C "void*".
+ // Since the other languages don't know about Fortran's discontiguity
+ // handling, such cases should require contiguity.
+ bool dummyIsVoidStar{dummyObj_.type.type().IsAssumedType() &&
+ dummyObj_.ignoreTKR.test(common::IgnoreTKR::Type) &&
+ dummyObj_.ignoreTKR.test(common::IgnoreTKR::Rank) &&
+ dummyObj_.ignoreTKR.test(common::IgnoreTKR::Kind)};
+ // Explicit shape and assumed size arrays must be contiguous
+ bool dummyNeedsContiguity{dummyIsExplicitShape || dummyIsAssumedSize ||
+ (dummyTreatAsArray && !dummyIsPolymorphic) || dummyIsVoidStar ||
+ dummyObj_.attrs.test(
+ characteristics::DummyDataObject::Attr::Contiguous)};
+ return !actualTreatAsContiguous && dummyNeedsContiguity;
+ }
+
+ // Returns true, if actual and dummy have polymorphic differences
+ bool HavePolymorphicDifferences() const {
+ bool dummyIsAssumedRank{dummyObj_.type.attrs().test(
+ characteristics::TypeAndShape::Attr::AssumedRank)};
+ bool actualIsAssumedRank{semantics::IsAssumedRank(actual_)};
+ bool dummyIsAssumedShape{dummyObj_.type.attrs().test(
+ characteristics::TypeAndShape::Attr::AssumedShape)};
+ bool actualIsAssumedShape{semantics::IsAssumedShape(actual_)};
+ if ((actualIsAssumedRank && dummyIsAssumedRank) ||
+ (actualIsAssumedShape && dummyIsAssumedShape)) {
+ // Assumed-rank and assumed-shape arrays are represented by descriptors,
+ // so don't need to do polymorphic check.
+ } else if (!dummyObj_.ignoreTKR.test(common::IgnoreTKR::Type)) {
+ // flang supports limited cases of passing polymorphic to non-polimorphic.
+ // These cases require temporary of non-polymorphic type. (For example,
+ // the actual argument could be polymorphic array of child type,
+ // while the dummy argument could be non-polymorphic array of parent
+ // type.)
+ bool dummyIsPolymorphic{dummyObj_.type.type().IsPolymorphic()};
+ auto actualType{
+ characteristics::TypeAndShape::Characterize(actual_, fc_)};
+ bool actualIsPolymorphic{
+ actualType && actualType->type().IsPolymorphic()};
+ if (actualIsPolymorphic && !dummyIsPolymorphic) {
+ return true;
+ }
+ }
+ return false;
+ }
+
+ bool HaveArrayOrAssumedRankArgs() const {
+ bool dummyTreatAsArray{dummyObj_.ignoreTKR.test(common::IgnoreTKR::Rank)};
+ return IsArrayOrAssumedRank(actual_) &&
+ (IsArrayOrAssumedRank(dummyObj_) || dummyTreatAsArray);
+ }
+
+ bool PassByValue() const {
+ return dummyObj_.attrs.test(characteristics::DummyDataObject::Attr::Value);
+ }
+
+ bool HaveCoarrayDifferences() const {
+ return ExtractCoarrayRef(actual_) && dummyObj_.type.corank() == 0;
+ }
+
+ bool HasIntentOut() const { return dummyObj_.intent == common::Intent::Out; }
+
+ bool HasIntentIn() const { return dummyObj_.intent == common::Intent::In; }
+
+ static bool IsArrayOrAssumedRank(const ActualArgument &actual) {
+ return semantics::IsAssumedRank(actual) || actual.Rank() > 0;
+ }
+
+ static bool IsArrayOrAssumedRank(
+ const characteristics::DummyDataObject &dummy) {
+ return dummy.type.attrs().test(
+ characteristics::TypeAndShape::Attr::AssumedRank) ||
+ dummy.type.Rank() > 0;
+ }
+
+private:
+ FoldingContext &fc_;
+ const ActualArgument &actual_;
+ const characteristics::DummyDataObject &dummyObj_;
+};
+
+// If forCopyOut is false, returns if a particular actual/dummy argument
+// combination may need a temporary creation with copy-in operation. If
+// forCopyOut is true, returns the same for copy-out operation. For
+// procedures with explicit interface, it's expected that "dummy" is not null.
+// For procedures with implicit interface dummy may be null.
+//
+// Note that these copy-in and copy-out checks are done from the caller's
+// perspective, meaning that for copy-in the caller need to do the copy
+// before calling the callee. Similarly, for copy-out the caller is expected
+// to do the copy after the callee returns.
+bool MayNeedCopy(const ActualArgument *actual,
+ const characteristics::DummyArgument *dummy, FoldingContext &fc,
+ bool forCopyOut) {
+ if (!actual) {
+ return false;
+ }
+ if (actual->isAlternateReturn()) {
+ return false;
+ }
+ const auto *dummyObj{dummy
+ ? std::get_if<characteristics::DummyDataObject>(&dummy->u)
+ : nullptr};
+ const bool forCopyIn = !forCopyOut;
+ if (!evaluate::IsVariable(*actual)) {
+ // Actual argument expressions that aren’t variables are copy-in, but
+ // not copy-out.
+ return forCopyIn;
+ }
+ if (dummyObj) { // Explict interface
+ CopyInOutExplicitInterface check{fc, *actual, *dummyObj};
+ if (forCopyOut && check.HasIntentIn()) {
+ // INTENT(IN) dummy args never need copy-out
+ return false;
+ }
+ if (forCopyIn && check.HasIntentOut()) {
+ // INTENT(OUT) dummy args never need copy-in
+ return false;
+ }
+ if (check.PassByValue()) {
+ // Pass by value, always copy-in, never copy-out
+ return forCopyIn;
+ }
+ if (check.HaveCoarrayDifferences()) {
+ return true;
+ }
+ // Note: contiguity and polymorphic checks deal with array or assumed rank
+ // arguments
+ if (!check.HaveArrayOrAssumedRankArgs()) {
+ return false;
+ }
+ if (check.HaveContiguityDifferences()) {
+ return true;
+ }
+ if (check.HavePolymorphicDifferences()) {
+ return true;
+ }
+ } else { // Implicit interface
+ if (ExtractCoarrayRef(*actual)) {
+ // Coindexed actual args may need copy-in and copy-out with implicit
+ // interface
+ return true;
+ }
+ if (!IsSimplyContiguous(*actual, fc)) {
+ // Copy-in: actual arguments that are variables are copy-in when
+ // non-contiguous.
+ // Copy-out: vector subscripts could refer to duplicate elements, can't
+ // copy out.
+ return !(forCopyOut && HasVectorSubscript(*actual));
+ }
+ }
+ // For everything else, no copy-in or copy-out
+ return false;
+}
+
} // namespace Fortran::evaluate
diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index 352dec4bb5ee2..ac50e77eae578 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -38,13 +38,13 @@ static bool CheckDimArg(const std::optional<ActualArgument> &dimArg,
const Expr<SomeType> &array, parser::ContextualMessages &messages,
bool isLBound, std::optional<int> &dimVal) {
dimVal.reset();
- if (int rank{array.Rank()}; rank > 0 || IsAssumedRank(array)) {
+ if (int rank{array.Rank()}; rank > 0 || semantics::IsAssumedRank(array)) {
auto named{ExtractNamedEntity(array)};
if (auto dim64{ToInt64(dimArg)}) {
if (*dim64 < 1) {
messages.Say("DIM=%jd dimension must be positive"_err_en_US, *dim64);
return false;
- } else if (!IsAssumedRank(array) && *dim64 > rank) {
+ } else if (!semantics::IsAssumedRank(array) && *dim64 > rank) {
messages.Say(
"DIM=%jd dimension is out of range for rank-%d array"_err_en_US,
*dim64, rank);
@@ -56,7 +56,7 @@ static bool CheckDimArg(const std::optional<ActualArgument> &dimArg,
"DIM=%jd dimension is out of range for rank-%d assumed-size array"_err_en_US,
*dim64, rank);
return false;
- } else if (IsAssumedRank(array)) {
+ } else if (semantics::IsAssumedRank(array)) {
if (*dim64 > common::maxRank) {
messages.Say(
"DIM=%jd dimension is too large for any array (maximum rank %d)"_err_en_US,
@@ -189,7 +189,7 @@ Expr<Type<TypeCategory::Integer, KIND>> LBOUND(FoldingContext &context,
return Expr<T>{std::move(funcRef)};
}
}
- if (IsAssumedRank(*array)) {
+ if (semantics::IsAssumedRank(*array)) {
// Would like to return 1 if DIM=.. is present, but that would be
// hiding a runtime error if the DIM= were too large (including
// the case of an assumed-rank argument that's scalar).
@@ -240,7 +240,7 @@ Expr<Type<TypeCategory::Integer, KIND>> UBOUND(FoldingContext &context,
return Expr<T>{std::move(funcRef)};
}
}
- if (IsAssumedRank(*array)) {
+ if (semantics::IsAssumedRank(*array)) {
} else if (int rank{array->Rank()}; rank > 0) {
bool takeBoundsFromShape{true};
if (auto named{ExtractNamedEntity(*array)}) {
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 4773e136c41cb..72513fff9f618 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2251,7 +2251,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
for (std::size_t j{0}; j < dummies; ++j) {
const IntrinsicDummyArgument &d{dummy[std::min(j, dummyArgPatterns - 1)]};
if (const ActualArgument *arg{actualForDummy[j]}) {
- bool isAssumedRank{IsAssumedRank(*arg)};
+ bool isAssumedRank{semantics::IsAssumedRank(*arg)};
if (isAssumedRank && d.rank != Rank::anyOrAssumedRank &&
d.rank != Rank::arrayOrAssumedRank) {
messages.Say(arg->sourceLocation(),
@@ -2997,7 +2997,7 @@ SpecificCall IntrinsicProcTable::Implementation::HandleNull(
mold = nullptr;
}
if (mold) {
- if (IsAssumedRank(*arguments[0])) {
+ if (semantics::IsAssumedRank(*arguments[0])) {
context.messages().Say(arguments[0]->sourceLocation(),
"MOLD= argument to NULL() must not be assumed-rank"_err_en_US);
}
diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index 776866d1416d2..bca95cbbba970 100644
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -947,7 +947,7 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
intrinsic->name == "ubound") {
// For LBOUND/UBOUND, these are the array-valued cases (no DIM=)
if (!call.arguments().empty() && call.arguments().front()) {
- if (IsAssumedRank(*call.arguments().front())) {
+ if (semantics::IsAssumedRank(*call.arguments().front())) {
return Shape{MaybeExtentExpr{}};
} else {
return Shape{
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 21e6b3c3dd50d..9273fcfa6a747 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -890,29 +890,6 @@ std::optional<Expr<SomeType>> ConvertToType(
}
}
-bool IsAssumedRank(const Symbol &original) {
- if (const auto *assoc{original.detailsIf<semantics::AssocEntityDetails>()}) {
- if (assoc->rank()) {
- return false; // in RANK(n) or RANK(*)
- } else if (assoc->IsAssumedRank()) {
- return true; // RANK DEFAULT
- }
- }
- const Symbol &symbol{semantics::ResolveAssociations(original)};
- const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()};
- return object && object->IsAssumedRank();
-}
-
-bool IsAssumedRank(const ActualArgument &arg) {
- if (const auto *expr{arg.UnwrapExpr()}) {
- return IsAssumedRank(*expr);
- } else {
- const Symbol *assumedTypeDummy{arg.GetAssumedTypeDummy()};
- CHECK(assumedTypeDummy);
- return IsAssumedRank(*assumedTypeDummy);
- }
-}
-
int GetCorank(const ActualArgument &arg) {
const auto *expr{arg.UnwrapExpr()};
return GetCorank(*expr);
@@ -1203,6 +1180,11 @@ bool HasVectorSubscript(const Expr<SomeType> &expr) {
return HasVectorSubscriptHelper{}(expr);
}
+bool HasVectorSubscript(const ActualArgument &actual) {
+ auto expr{actual.UnwrapExpr()};
+ return expr && HasVectorSubscript(*expr);
+}
+
// HasConstant()
struct HasConstantHelper : public AnyTraverse<HasConstantHelper, bool,
/*TraverseAssocEntityDetails=*/false> {
@@ -2276,9 +2258,22 @@ bool IsDummy(const Symbol &symbol) {
ResolveAssociations(symbol).details());
}
+bool IsAssumedRank(const Symbol &original) {
+ if (const auto *assoc{original.detailsIf<semantics::AssocEntityDetails>()}) {
+ if (assoc->rank()) {
+ return false; // in RANK(n) or RANK(*)
+ } else if (assoc->IsAssumedRank()) {
+ return true; // RANK DEFAULT
+ }
+ }
+ const Symbol &symbol{semantics::ResolveAssociations(original)};
+ const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()};
+ return object && object->IsAssumedRank();
+}
+
bool IsAssumedShape(const Symbol &symbol) {
const Symbol &ultimate{ResolveAssociations(symbol)};
- const auto *object{ultimate.detailsIf<ObjectEntityDetails>()};
+ const auto *object{ultimate.detailsIf<semantics::ObjectEntityDetails>()};
return object && object->IsAssumedShape() &&
!semantics::IsAllocatableOrObjectPointer(&ultimate);
}
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 6ed15df0de754..1c63a07f08f94 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -881,9 +881,10 @@ struct CallContext {
std::optional<mlir::Type> resultType, mlir::Location loc,
Fortran::lower::AbstractConverter &converter,
Fortran::lower::SymMap &symMap,
- Fortran::lower::StatementContext &stmtCtx)
+ Fortran::lower::StatementContext &stmtCtx, bool doCopyIn = true)
:...
[truncated]
|
@llvm/pr-subscribers-flang-semantics Author: Tom Eccles (tblah) ChangesBackport of #151408 New implementation of
Fixes #138471 Conflicts in backport were trivial. Remove modifications of new code not present in 21.x branch: Patch is 42.18 KiB, truncated to 20.00 KiB below, full version: https://github.com/llvm/llvm-project/pull/155810.diff 22 Files Affected:
diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index d566c34ff71e8..b6a9ebefec9df 100644
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -203,6 +203,12 @@ class TypeAndShape {
std::optional<Expr<SubscriptInteger>> MeasureSizeInBytes(
FoldingContext &) const;
+ bool IsExplicitShape() const {
+ // If it's array and no special attributes are set, then must be
+ // explicit shape.
+ return Rank() > 0 && attrs_.none();
+ }
+
// called by Fold() to rewrite in place
TypeAndShape &Rewrite(FoldingContext &);
diff --git a/flang/include/flang/Evaluate/check-expression.h b/flang/include/flang/Evaluate/check-expression.h
index 0cf12f340ec5c..9a0885f4d0996 100644
--- a/flang/include/flang/Evaluate/check-expression.h
+++ b/flang/include/flang/Evaluate/check-expression.h
@@ -118,6 +118,9 @@ std::optional<bool> IsContiguous(const A &, FoldingContext &,
extern template std::optional<bool> IsContiguous(const Expr<SomeType> &,
FoldingContext &, bool namedConstantSectionsAreContiguous,
bool firstDimensionStride1);
+extern template std::optional<bool> IsContiguous(const ActualArgument &,
+ FoldingContext &, bool namedConstantSectionsAreContiguous,
+ bool firstDimensionStride1);
extern template std::optional<bool> IsContiguous(const ArrayRef &,
FoldingContext &, bool namedConstantSectionsAreContiguous,
bool firstDimensionStride1);
@@ -153,5 +156,8 @@ extern template bool IsErrorExpr(const Expr<SomeType> &);
std::optional<parser::Message> CheckStatementFunction(
const Symbol &, const Expr<SomeType> &, FoldingContext &);
+bool MayNeedCopy(const ActualArgument *, const characteristics::DummyArgument *,
+ FoldingContext &, bool forCopyOut);
+
} // namespace Fortran::evaluate
#endif
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index 96ed86f468350..55f23fbdcbb70 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -81,27 +81,6 @@ template <typename A> bool IsVariable(const A &x) {
}
}
-// Predicate: true when an expression is assumed-rank
-bool IsAssumedRank(const Symbol &);
-bool IsAssumedRank(const ActualArgument &);
-template <typename A> bool IsAssumedRank(const A &) { return false; }
-template <typename A> bool IsAssumedRank(const Designator<A> &designator) {
- if (const auto *symbol{std::get_if<SymbolRef>(&designator.u)}) {
- return IsAssumedRank(symbol->get());
- } else {
- return false;
- }
-}
-template <typename T> bool IsAssumedRank(const Expr<T> &expr) {
- return common::visit([](const auto &x) { return IsAssumedRank(x); }, expr.u);
-}
-template <typename A> bool IsAssumedRank(const std::optional<A> &x) {
- return x && IsAssumedRank(*x);
-}
-template <typename A> bool IsAssumedRank(const A *x) {
- return x && IsAssumedRank(*x);
-}
-
// Finds the corank of an entity, possibly packaged in various ways.
// Unlike rank, only data references have corank > 0.
int GetCorank(const ActualArgument &);
@@ -1122,6 +1101,7 @@ extern template semantics::UnorderedSymbolSet CollectCudaSymbols(
// Predicate: does a variable contain a vector-valued subscript (not a triplet)?
bool HasVectorSubscript(const Expr<SomeType> &);
+bool HasVectorSubscript(const ActualArgument &);
// Predicate: does an expression contain constant?
bool HasConstant(const Expr<SomeType> &);
@@ -1548,7 +1528,19 @@ bool IsAllocatableOrObjectPointer(const Symbol *);
bool IsAutomatic(const Symbol &);
bool IsSaved(const Symbol &); // saved implicitly or explicitly
bool IsDummy(const Symbol &);
+
+bool IsAssumedRank(const Symbol &);
+template <typename A> bool IsAssumedRank(const A &x) {
+ auto *symbol{UnwrapWholeSymbolDataRef(x)};
+ return symbol && IsAssumedRank(*symbol);
+}
+
bool IsAssumedShape(const Symbol &);
+template <typename A> bool IsAssumedShape(const A &x) {
+ auto *symbol{UnwrapWholeSymbolDataRef(x)};
+ return symbol && IsAssumedShape(*symbol);
+}
+
bool IsDeferredShape(const Symbol &);
bool IsFunctionResult(const Symbol &);
bool IsKindTypeParameter(const Symbol &);
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 3d7f01d56c465..aae92933e42d8 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -917,8 +917,8 @@ class IsContiguousHelper
} else {
return Base::operator()(ultimate); // use expr
}
- } else if (semantics::IsPointer(ultimate) ||
- semantics::IsAssumedShape(ultimate) || IsAssumedRank(ultimate)) {
+ } else if (semantics::IsPointer(ultimate) || IsAssumedShape(ultimate) ||
+ IsAssumedRank(ultimate)) {
return std::nullopt;
} else if (ultimate.has<semantics::ObjectEntityDetails>()) {
return true;
@@ -1198,9 +1198,21 @@ std::optional<bool> IsContiguous(const A &x, FoldingContext &context,
}
}
+std::optional<bool> IsContiguous(const ActualArgument &actual,
+ FoldingContext &fc, bool namedConstantSectionsAreContiguous,
+ bool firstDimensionStride1) {
+ auto *expr{actual.UnwrapExpr()};
+ return expr &&
+ IsContiguous(
+ *expr, fc, namedConstantSectionsAreContiguous, firstDimensionStride1);
+}
+
template std::optional<bool> IsContiguous(const Expr<SomeType> &,
FoldingContext &, bool namedConstantSectionsAreContiguous,
bool firstDimensionStride1);
+template std::optional<bool> IsContiguous(const ActualArgument &,
+ FoldingContext &, bool namedConstantSectionsAreContiguous,
+ bool firstDimensionStride1);
template std::optional<bool> IsContiguous(const ArrayRef &, FoldingContext &,
bool namedConstantSectionsAreContiguous, bool firstDimensionStride1);
template std::optional<bool> IsContiguous(const Substring &, FoldingContext &,
@@ -1350,4 +1362,177 @@ std::optional<parser::Message> CheckStatementFunction(
return StmtFunctionChecker{sf, context}(expr);
}
+// Helper class for checking differences between actual and dummy arguments
+class CopyInOutExplicitInterface {
+public:
+ explicit CopyInOutExplicitInterface(FoldingContext &fc,
+ const ActualArgument &actual,
+ const characteristics::DummyDataObject &dummyObj)
+ : fc_{fc}, actual_{actual}, dummyObj_{dummyObj} {}
+
+ // Returns true, if actual and dummy have different contiguity requirements
+ bool HaveContiguityDifferences() const {
+ // Check actual contiguity, unless dummy doesn't care
+ bool dummyTreatAsArray{dummyObj_.ignoreTKR.test(common::IgnoreTKR::Rank)};
+ bool actualTreatAsContiguous{
+ dummyObj_.ignoreTKR.test(common::IgnoreTKR::Contiguous) ||
+ IsSimplyContiguous(actual_, fc_)};
+ bool dummyIsExplicitShape{dummyObj_.type.IsExplicitShape()};
+ bool dummyIsAssumedSize{dummyObj_.type.attrs().test(
+ characteristics::TypeAndShape::Attr::AssumedSize)};
+ bool dummyIsPolymorphic{dummyObj_.type.type().IsPolymorphic()};
+ // type(*) with IGNORE_TKR(tkr) is often used to interface with C "void*".
+ // Since the other languages don't know about Fortran's discontiguity
+ // handling, such cases should require contiguity.
+ bool dummyIsVoidStar{dummyObj_.type.type().IsAssumedType() &&
+ dummyObj_.ignoreTKR.test(common::IgnoreTKR::Type) &&
+ dummyObj_.ignoreTKR.test(common::IgnoreTKR::Rank) &&
+ dummyObj_.ignoreTKR.test(common::IgnoreTKR::Kind)};
+ // Explicit shape and assumed size arrays must be contiguous
+ bool dummyNeedsContiguity{dummyIsExplicitShape || dummyIsAssumedSize ||
+ (dummyTreatAsArray && !dummyIsPolymorphic) || dummyIsVoidStar ||
+ dummyObj_.attrs.test(
+ characteristics::DummyDataObject::Attr::Contiguous)};
+ return !actualTreatAsContiguous && dummyNeedsContiguity;
+ }
+
+ // Returns true, if actual and dummy have polymorphic differences
+ bool HavePolymorphicDifferences() const {
+ bool dummyIsAssumedRank{dummyObj_.type.attrs().test(
+ characteristics::TypeAndShape::Attr::AssumedRank)};
+ bool actualIsAssumedRank{semantics::IsAssumedRank(actual_)};
+ bool dummyIsAssumedShape{dummyObj_.type.attrs().test(
+ characteristics::TypeAndShape::Attr::AssumedShape)};
+ bool actualIsAssumedShape{semantics::IsAssumedShape(actual_)};
+ if ((actualIsAssumedRank && dummyIsAssumedRank) ||
+ (actualIsAssumedShape && dummyIsAssumedShape)) {
+ // Assumed-rank and assumed-shape arrays are represented by descriptors,
+ // so don't need to do polymorphic check.
+ } else if (!dummyObj_.ignoreTKR.test(common::IgnoreTKR::Type)) {
+ // flang supports limited cases of passing polymorphic to non-polimorphic.
+ // These cases require temporary of non-polymorphic type. (For example,
+ // the actual argument could be polymorphic array of child type,
+ // while the dummy argument could be non-polymorphic array of parent
+ // type.)
+ bool dummyIsPolymorphic{dummyObj_.type.type().IsPolymorphic()};
+ auto actualType{
+ characteristics::TypeAndShape::Characterize(actual_, fc_)};
+ bool actualIsPolymorphic{
+ actualType && actualType->type().IsPolymorphic()};
+ if (actualIsPolymorphic && !dummyIsPolymorphic) {
+ return true;
+ }
+ }
+ return false;
+ }
+
+ bool HaveArrayOrAssumedRankArgs() const {
+ bool dummyTreatAsArray{dummyObj_.ignoreTKR.test(common::IgnoreTKR::Rank)};
+ return IsArrayOrAssumedRank(actual_) &&
+ (IsArrayOrAssumedRank(dummyObj_) || dummyTreatAsArray);
+ }
+
+ bool PassByValue() const {
+ return dummyObj_.attrs.test(characteristics::DummyDataObject::Attr::Value);
+ }
+
+ bool HaveCoarrayDifferences() const {
+ return ExtractCoarrayRef(actual_) && dummyObj_.type.corank() == 0;
+ }
+
+ bool HasIntentOut() const { return dummyObj_.intent == common::Intent::Out; }
+
+ bool HasIntentIn() const { return dummyObj_.intent == common::Intent::In; }
+
+ static bool IsArrayOrAssumedRank(const ActualArgument &actual) {
+ return semantics::IsAssumedRank(actual) || actual.Rank() > 0;
+ }
+
+ static bool IsArrayOrAssumedRank(
+ const characteristics::DummyDataObject &dummy) {
+ return dummy.type.attrs().test(
+ characteristics::TypeAndShape::Attr::AssumedRank) ||
+ dummy.type.Rank() > 0;
+ }
+
+private:
+ FoldingContext &fc_;
+ const ActualArgument &actual_;
+ const characteristics::DummyDataObject &dummyObj_;
+};
+
+// If forCopyOut is false, returns if a particular actual/dummy argument
+// combination may need a temporary creation with copy-in operation. If
+// forCopyOut is true, returns the same for copy-out operation. For
+// procedures with explicit interface, it's expected that "dummy" is not null.
+// For procedures with implicit interface dummy may be null.
+//
+// Note that these copy-in and copy-out checks are done from the caller's
+// perspective, meaning that for copy-in the caller need to do the copy
+// before calling the callee. Similarly, for copy-out the caller is expected
+// to do the copy after the callee returns.
+bool MayNeedCopy(const ActualArgument *actual,
+ const characteristics::DummyArgument *dummy, FoldingContext &fc,
+ bool forCopyOut) {
+ if (!actual) {
+ return false;
+ }
+ if (actual->isAlternateReturn()) {
+ return false;
+ }
+ const auto *dummyObj{dummy
+ ? std::get_if<characteristics::DummyDataObject>(&dummy->u)
+ : nullptr};
+ const bool forCopyIn = !forCopyOut;
+ if (!evaluate::IsVariable(*actual)) {
+ // Actual argument expressions that aren’t variables are copy-in, but
+ // not copy-out.
+ return forCopyIn;
+ }
+ if (dummyObj) { // Explict interface
+ CopyInOutExplicitInterface check{fc, *actual, *dummyObj};
+ if (forCopyOut && check.HasIntentIn()) {
+ // INTENT(IN) dummy args never need copy-out
+ return false;
+ }
+ if (forCopyIn && check.HasIntentOut()) {
+ // INTENT(OUT) dummy args never need copy-in
+ return false;
+ }
+ if (check.PassByValue()) {
+ // Pass by value, always copy-in, never copy-out
+ return forCopyIn;
+ }
+ if (check.HaveCoarrayDifferences()) {
+ return true;
+ }
+ // Note: contiguity and polymorphic checks deal with array or assumed rank
+ // arguments
+ if (!check.HaveArrayOrAssumedRankArgs()) {
+ return false;
+ }
+ if (check.HaveContiguityDifferences()) {
+ return true;
+ }
+ if (check.HavePolymorphicDifferences()) {
+ return true;
+ }
+ } else { // Implicit interface
+ if (ExtractCoarrayRef(*actual)) {
+ // Coindexed actual args may need copy-in and copy-out with implicit
+ // interface
+ return true;
+ }
+ if (!IsSimplyContiguous(*actual, fc)) {
+ // Copy-in: actual arguments that are variables are copy-in when
+ // non-contiguous.
+ // Copy-out: vector subscripts could refer to duplicate elements, can't
+ // copy out.
+ return !(forCopyOut && HasVectorSubscript(*actual));
+ }
+ }
+ // For everything else, no copy-in or copy-out
+ return false;
+}
+
} // namespace Fortran::evaluate
diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index 352dec4bb5ee2..ac50e77eae578 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -38,13 +38,13 @@ static bool CheckDimArg(const std::optional<ActualArgument> &dimArg,
const Expr<SomeType> &array, parser::ContextualMessages &messages,
bool isLBound, std::optional<int> &dimVal) {
dimVal.reset();
- if (int rank{array.Rank()}; rank > 0 || IsAssumedRank(array)) {
+ if (int rank{array.Rank()}; rank > 0 || semantics::IsAssumedRank(array)) {
auto named{ExtractNamedEntity(array)};
if (auto dim64{ToInt64(dimArg)}) {
if (*dim64 < 1) {
messages.Say("DIM=%jd dimension must be positive"_err_en_US, *dim64);
return false;
- } else if (!IsAssumedRank(array) && *dim64 > rank) {
+ } else if (!semantics::IsAssumedRank(array) && *dim64 > rank) {
messages.Say(
"DIM=%jd dimension is out of range for rank-%d array"_err_en_US,
*dim64, rank);
@@ -56,7 +56,7 @@ static bool CheckDimArg(const std::optional<ActualArgument> &dimArg,
"DIM=%jd dimension is out of range for rank-%d assumed-size array"_err_en_US,
*dim64, rank);
return false;
- } else if (IsAssumedRank(array)) {
+ } else if (semantics::IsAssumedRank(array)) {
if (*dim64 > common::maxRank) {
messages.Say(
"DIM=%jd dimension is too large for any array (maximum rank %d)"_err_en_US,
@@ -189,7 +189,7 @@ Expr<Type<TypeCategory::Integer, KIND>> LBOUND(FoldingContext &context,
return Expr<T>{std::move(funcRef)};
}
}
- if (IsAssumedRank(*array)) {
+ if (semantics::IsAssumedRank(*array)) {
// Would like to return 1 if DIM=.. is present, but that would be
// hiding a runtime error if the DIM= were too large (including
// the case of an assumed-rank argument that's scalar).
@@ -240,7 +240,7 @@ Expr<Type<TypeCategory::Integer, KIND>> UBOUND(FoldingContext &context,
return Expr<T>{std::move(funcRef)};
}
}
- if (IsAssumedRank(*array)) {
+ if (semantics::IsAssumedRank(*array)) {
} else if (int rank{array->Rank()}; rank > 0) {
bool takeBoundsFromShape{true};
if (auto named{ExtractNamedEntity(*array)}) {
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 4773e136c41cb..72513fff9f618 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2251,7 +2251,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
for (std::size_t j{0}; j < dummies; ++j) {
const IntrinsicDummyArgument &d{dummy[std::min(j, dummyArgPatterns - 1)]};
if (const ActualArgument *arg{actualForDummy[j]}) {
- bool isAssumedRank{IsAssumedRank(*arg)};
+ bool isAssumedRank{semantics::IsAssumedRank(*arg)};
if (isAssumedRank && d.rank != Rank::anyOrAssumedRank &&
d.rank != Rank::arrayOrAssumedRank) {
messages.Say(arg->sourceLocation(),
@@ -2997,7 +2997,7 @@ SpecificCall IntrinsicProcTable::Implementation::HandleNull(
mold = nullptr;
}
if (mold) {
- if (IsAssumedRank(*arguments[0])) {
+ if (semantics::IsAssumedRank(*arguments[0])) {
context.messages().Say(arguments[0]->sourceLocation(),
"MOLD= argument to NULL() must not be assumed-rank"_err_en_US);
}
diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index 776866d1416d2..bca95cbbba970 100644
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -947,7 +947,7 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
intrinsic->name == "ubound") {
// For LBOUND/UBOUND, these are the array-valued cases (no DIM=)
if (!call.arguments().empty() && call.arguments().front()) {
- if (IsAssumedRank(*call.arguments().front())) {
+ if (semantics::IsAssumedRank(*call.arguments().front())) {
return Shape{MaybeExtentExpr{}};
} else {
return Shape{
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 21e6b3c3dd50d..9273fcfa6a747 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -890,29 +890,6 @@ std::optional<Expr<SomeType>> ConvertToType(
}
}
-bool IsAssumedRank(const Symbol &original) {
- if (const auto *assoc{original.detailsIf<semantics::AssocEntityDetails>()}) {
- if (assoc->rank()) {
- return false; // in RANK(n) or RANK(*)
- } else if (assoc->IsAssumedRank()) {
- return true; // RANK DEFAULT
- }
- }
- const Symbol &symbol{semantics::ResolveAssociations(original)};
- const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()};
- return object && object->IsAssumedRank();
-}
-
-bool IsAssumedRank(const ActualArgument &arg) {
- if (const auto *expr{arg.UnwrapExpr()}) {
- return IsAssumedRank(*expr);
- } else {
- const Symbol *assumedTypeDummy{arg.GetAssumedTypeDummy()};
- CHECK(assumedTypeDummy);
- return IsAssumedRank(*assumedTypeDummy);
- }
-}
-
int GetCorank(const ActualArgument &arg) {
const auto *expr{arg.UnwrapExpr()};
return GetCorank(*expr);
@@ -1203,6 +1180,11 @@ bool HasVectorSubscript(const Expr<SomeType> &expr) {
return HasVectorSubscriptHelper{}(expr);
}
+bool HasVectorSubscript(const ActualArgument &actual) {
+ auto expr{actual.UnwrapExpr()};
+ return expr && HasVectorSubscript(*expr);
+}
+
// HasConstant()
struct HasConstantHelper : public AnyTraverse<HasConstantHelper, bool,
/*TraverseAssocEntityDetails=*/false> {
@@ -2276,9 +2258,22 @@ bool IsDummy(const Symbol &symbol) {
ResolveAssociations(symbol).details());
}
+bool IsAssumedRank(const Symbol &original) {
+ if (const auto *assoc{original.detailsIf<semantics::AssocEntityDetails>()}) {
+ if (assoc->rank()) {
+ return false; // in RANK(n) or RANK(*)
+ } else if (assoc->IsAssumedRank()) {
+ return true; // RANK DEFAULT
+ }
+ }
+ const Symbol &symbol{semantics::ResolveAssociations(original)};
+ const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()};
+ return object && object->IsAssumedRank();
+}
+
bool IsAssumedShape(const Symbol &symbol) {
const Symbol &ultimate{ResolveAssociations(symbol)};
- const auto *object{ultimate.detailsIf<ObjectEntityDetails>()};
+ const auto *object{ultimate.detailsIf<semantics::ObjectEntityDetails>()};
return object && object->IsAssumedShape() &&
!semantics::IsAllocatableOrObjectPointer(&ultimate);
}
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 6ed15df0de754..1c63a07f08f94 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -881,9 +881,10 @@ struct CallContext {
std::optional<mlir::Type> resultType, mlir::Location loc,
Fortran::lower::AbstractConverter &converter,
Fortran::lower::SymMap &symMap,
- Fortran::lower::StatementContext &stmtCtx)
+ Fortran::lower::StatementContext &stmtCtx, bool doCopyIn = true)
:...
[truncated]
|
Requesting a back-port of this because it is a fix for an important HPC application and it was requested by the issue reporter in #138471 |
@tru I'm not familiar with the version check CI job. It seems to be expecting a different version number for LLVM. Is this PR based on the wrong branch? |
@tblah the branch is right, there's no other 21.x branch. I presume this is some kind of stale issue with version checker, and since there is not much (if any) PRs targeting a release branch directly (these are mostly cherry-pick requests or direct commits), no one noticed that there's a problem. |
Backport of #151408
New implementation of
MayNeedCopy()
is used to consolidate copy-in/copy-out checks.IsAssumedShape()
andIsAssumedRank()
were simplified and are both now inFortran::semantics
workspace.preparePresentUserCallActualArgument()
in lowering was modified to useMayNeedCopyInOut()
Fixes #138471
Conflicts in backport were trivial. Remove modifications of new code not present in 21.x branch:
flang/lib/Semantics/check-omp-structure.cpp
flang/lib/Semantics/resolve-directives.cpp