From 54c0158dcce9b5ebb6a3658298dedcda72b41f52 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Wed, 30 Jul 2025 17:08:06 -0400 Subject: [PATCH 01/79] [flang][DRAFT] Copy-in/Copy-out determination Plumbing/API for copy-in/copy-out --- flang/include/flang/Evaluate/call.h | 19 +++++++++++++++++-- flang/lib/Evaluate/call.cpp | 16 ++++++++++++++++ 2 files changed, 33 insertions(+), 2 deletions(-) diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h index 2a5929b873d74..ac11527e4ecaa 100644 --- a/flang/include/flang/Evaluate/call.h +++ b/flang/include/flang/Evaluate/call.h @@ -52,7 +52,7 @@ using SymbolRef = common::Reference; class ActualArgument { public: - ENUM_CLASS(Attr, PassedObject, PercentVal, PercentRef); + ENUM_CLASS(Attr, PassedObject, PercentVal, PercentRef, CopyIn, CopyOut); using Attrs = common::EnumSet; // Dummy arguments that are TYPE(*) can be forwarded as actual arguments. @@ -131,7 +131,6 @@ class ActualArgument { return *this; } - bool Matches(const characteristics::DummyArgument &) const; common::Intent dummyIntent() const { return dummyIntent_; } ActualArgument &set_dummyIntent(common::Intent intent) { dummyIntent_ = intent; @@ -161,6 +160,20 @@ class ActualArgument { return *this; } + // This actual argument may need copy-in before the procedure call + bool mayNeedCopyIn() const { return attrs_.test(Attr::CopyIn); }; + ActualArgument &set_mayNeedCopyIn() { + attrs_ = attrs_ + Attr::CopyIn; + return *this; + } + + // This actual argument may need copy-out after the procedure call + bool mayNeedCopyOut() const { return attrs_.test(Attr::CopyOut); }; + ActualArgument &set_mayNeedCopyOut() { + attrs_ = attrs_ + Attr::CopyOut; + return *this; + } + private: // Subtlety: There is a distinction that must be maintained here between an // actual argument expression that is a variable and one that is not, @@ -272,6 +285,8 @@ class ProcedureRef { bool operator==(const ProcedureRef &) const; llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const; + void DetermineCopyInOut(); + protected: ProcedureDesignator proc_; ActualArguments arguments_; diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index f77df92a7597a..1e582a516a694 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -13,6 +13,7 @@ #include "flang/Evaluate/expression.h" #include "flang/Evaluate/tools.h" #include "flang/Semantics/symbol.h" +#include "flang/Semantics/semantics.h" #include "flang/Support/Fortran.h" namespace Fortran::evaluate { @@ -247,4 +248,19 @@ ProcedureRef::~ProcedureRef() {} void ProcedureRef::Deleter(ProcedureRef *p) { delete p; } +void ProcedureRef::DetermineCopyInOut() { + if (!proc().GetSymbol()) { + return; + } + // Get folding context of the call site owner + FoldingContext &fc{proc_.GetSymbol()->owner().context().foldingContext()}; + auto procInfo{characteristics::Procedure::Characterize( + proc(), fc, /*emitError=*/false)}; + if (!procInfo) { + return; + } + // TODO: at this point have dummy arguments as procInfo->dummyArguments + // and have actual arguments via arguments_ +} + } // namespace Fortran::evaluate From 808fb20c3e4d6dc80b7e3793fb28b4f7854b07f8 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Wed, 30 Jul 2025 17:44:37 -0400 Subject: [PATCH 02/79] Call DetermineCopyInOut() from lowering --- flang/include/flang/Lower/CallInterface.h | 3 +++ 1 file changed, 3 insertions(+) diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h index 72bc9dd890a94..eca697d474c47 100644 --- a/flang/include/flang/Lower/CallInterface.h +++ b/flang/include/flang/Lower/CallInterface.h @@ -284,6 +284,9 @@ class CallerInterface : public CallInterface { CallerInterface(const Fortran::evaluate::ProcedureRef &p, Fortran::lower::AbstractConverter &c) : CallInterface{c}, procRef{p} { + // Ensure that procRef gathers necessary information to determine the + // need for copy-in and copy-out + const_cast(procRef).DetermineCopyInOut(); declare(); mapPassedEntities(); actualInputs.resize(getNumFIRArguments()); From 28bc5bd95f83f131c4a905f69e402fc97a1b7e9d Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Wed, 30 Jul 2025 18:20:23 -0400 Subject: [PATCH 03/79] clang-format --- flang/lib/Evaluate/call.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index 1e582a516a694..0cfad4cfae17e 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -12,8 +12,8 @@ #include "flang/Evaluate/check-expression.h" #include "flang/Evaluate/expression.h" #include "flang/Evaluate/tools.h" -#include "flang/Semantics/symbol.h" #include "flang/Semantics/semantics.h" +#include "flang/Semantics/symbol.h" #include "flang/Support/Fortran.h" namespace Fortran::evaluate { From f44b9459f6e2c0f60d6f66d00ec37d383befe021 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Wed, 30 Jul 2025 19:54:01 -0400 Subject: [PATCH 04/79] DetermineCopyInOut() is now called from ProcedureRef constructor --- flang/include/flang/Evaluate/call.h | 8 ++++++-- flang/include/flang/Lower/CallInterface.h | 3 --- flang/lib/Evaluate/call.cpp | 2 +- 3 files changed, 7 insertions(+), 6 deletions(-) diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h index ac11527e4ecaa..56338901b22bb 100644 --- a/flang/include/flang/Evaluate/call.h +++ b/flang/include/flang/Evaluate/call.h @@ -248,7 +248,11 @@ class ProcedureRef { ProcedureRef(ProcedureDesignator &&p, ActualArguments &&a, bool hasAlternateReturns = false) : proc_{std::move(p)}, arguments_{std::move(a)}, - hasAlternateReturns_{hasAlternateReturns} {} + hasAlternateReturns_{hasAlternateReturns} { + // Gathers necessary information to determine the need for copy-in and + // copy-out + DetermineCopyInOut(); + } ~ProcedureRef(); static void Deleter(ProcedureRef *); @@ -285,9 +289,9 @@ class ProcedureRef { bool operator==(const ProcedureRef &) const; llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const; +protected: void DetermineCopyInOut(); -protected: ProcedureDesignator proc_; ActualArguments arguments_; Chevrons chevrons_; diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h index eca697d474c47..72bc9dd890a94 100644 --- a/flang/include/flang/Lower/CallInterface.h +++ b/flang/include/flang/Lower/CallInterface.h @@ -284,9 +284,6 @@ class CallerInterface : public CallInterface { CallerInterface(const Fortran::evaluate::ProcedureRef &p, Fortran::lower::AbstractConverter &c) : CallInterface{c}, procRef{p} { - // Ensure that procRef gathers necessary information to determine the - // need for copy-in and copy-out - const_cast(procRef).DetermineCopyInOut(); declare(); mapPassedEntities(); actualInputs.resize(getNumFIRArguments()); diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index 0cfad4cfae17e..c558335c16545 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -255,7 +255,7 @@ void ProcedureRef::DetermineCopyInOut() { // Get folding context of the call site owner FoldingContext &fc{proc_.GetSymbol()->owner().context().foldingContext()}; auto procInfo{characteristics::Procedure::Characterize( - proc(), fc, /*emitError=*/false)}; + proc_, fc, /*emitError=*/true)}; if (!procInfo) { return; } From ffd65635da52fb2788056113b9fa3bdf2d430436 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Wed, 30 Jul 2025 19:57:40 -0400 Subject: [PATCH 05/79] clang-format --- flang/lib/Evaluate/call.cpp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index c558335c16545..5a94071d9bf20 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -254,8 +254,8 @@ void ProcedureRef::DetermineCopyInOut() { } // Get folding context of the call site owner FoldingContext &fc{proc_.GetSymbol()->owner().context().foldingContext()}; - auto procInfo{characteristics::Procedure::Characterize( - proc_, fc, /*emitError=*/true)}; + auto procInfo{ + characteristics::Procedure::Characterize(proc_, fc, /*emitError=*/true)}; if (!procInfo) { return; } From fb3a93c6da7f34110734f606e795533b83ff1562 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Wed, 30 Jul 2025 22:39:44 -0400 Subject: [PATCH 06/79] Minor tweak --- flang/lib/Evaluate/call.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index 5a94071d9bf20..605931d5d6dfb 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -249,7 +249,7 @@ ProcedureRef::~ProcedureRef() {} void ProcedureRef::Deleter(ProcedureRef *p) { delete p; } void ProcedureRef::DetermineCopyInOut() { - if (!proc().GetSymbol()) { + if (!proc_.GetSymbol()) { return; } // Get folding context of the call site owner From 527b2d7646ca11a4fa9921695b4efd360a9c5b54 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Thu, 31 Jul 2025 13:32:10 -0400 Subject: [PATCH 07/79] DetermineCopyInOut() is now called at ProcedureRef instantiation --- flang/include/flang/Evaluate/call.h | 5 +---- flang/lib/Semantics/expression.cpp | 1 + 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h index 56338901b22bb..3d4f791380fba 100644 --- a/flang/include/flang/Evaluate/call.h +++ b/flang/include/flang/Evaluate/call.h @@ -249,9 +249,6 @@ class ProcedureRef { bool hasAlternateReturns = false) : proc_{std::move(p)}, arguments_{std::move(a)}, hasAlternateReturns_{hasAlternateReturns} { - // Gathers necessary information to determine the need for copy-in and - // copy-out - DetermineCopyInOut(); } ~ProcedureRef(); static void Deleter(ProcedureRef *); @@ -289,9 +286,9 @@ class ProcedureRef { bool operator==(const ProcedureRef &) const; llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const; -protected: void DetermineCopyInOut(); +protected: ProcedureDesignator proc_; ActualArguments arguments_; Chevrons chevrons_; diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index 92dbe0e5da11c..29917a570ddc5 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -3455,6 +3455,7 @@ void ExpressionAnalyzer::Analyze(const parser::CallStmt &callStmt) { HasAlternateReturns(callee->arguments)}, ProcedureRef::Deleter); DEREF(callStmt.typedCall.get()).set_chevrons(std::move(*chevrons)); + DEREF(callStmt.typedCall.get()).DetermineCopyInOut(); return; } } From 9c1755b248f4fe7b38547af5ee74563cfdcd6753 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Thu, 31 Jul 2025 22:01:17 -0400 Subject: [PATCH 08/79] Very rough beginnings of argument handling in DetermineCopyInOut() --- flang/lib/Evaluate/call.cpp | 61 +++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index 605931d5d6dfb..6f604d2aed28b 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -248,6 +248,23 @@ ProcedureRef::~ProcedureRef() {} void ProcedureRef::Deleter(ProcedureRef *p) { delete p; } +// We don't know the dummy argument info (e.g., procedure with implicit +// interface +static void DetermineCopyInOutArgument( + const characteristics::Procedure &procInfo, ActualArgument &actual) { + + // Only check that actual argument is contiguous + // For non-contiguous, do copy-in +} + +static void DetermineCopyInOutArgument( + const characteristics::Procedure &procInfo, + ActualArgument &actual, characteristics::DummyArgument &dummy) { + + // TODO: assert? procInfo.HasExplicitInterface() + +} + void ProcedureRef::DetermineCopyInOut() { if (!proc_.GetSymbol()) { return; @@ -261,6 +278,50 @@ void ProcedureRef::DetermineCopyInOut() { } // TODO: at this point have dummy arguments as procInfo->dummyArguments // and have actual arguments via arguments_ + + // TODO: implicitly declared procedure may not have any information about + // its dummy args. Handle this case. + + // Don't change anything about actual or dummy arguments, except for + // computing copy-in/copy-out information. If detect something wrong with + // the arguments, stop processing and let semantic analysis generate the + // error messages. + size_t index{0}; + std::set processedKeywords; + bool seenKeyword{false}; + for (auto &actual : arguments_) { + if (!actual) { + continue; + } + if (index >= procInfo->dummyArguments.size()) { + // More actual arguments than dummy arguments. Semantic analysis will + // deal with the error. + return; + } + if (actual->keyword()) { + seenKeyword = true; + auto actualName = actual->keyword()->ToString(); + if (processedKeywords.find(actualName) != processedKeywords.end()) { + // Actual arguments with duplicate keywords. Semantic analysis will + // deal with the error. + return; + } + else { + processedKeywords.insert(actualName); + + } + } + else if (seenKeyword) { + // Non-keyword actual argument after have seen at least one keyword + // actual argument. Semantic analysis will deal with the error. + return; + } + else { + // Positional argument processing + } + + ++index; + } } } // namespace Fortran::evaluate From 3198e9059218f6a1ecccd9e609e6eb9e425281e0 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Thu, 31 Jul 2025 22:20:18 -0400 Subject: [PATCH 09/79] More args handing in DetermineCopyInOut() --- flang/lib/Evaluate/call.cpp | 25 ++++++++++++++++++------- 1 file changed, 18 insertions(+), 7 deletions(-) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index 6f604d2aed28b..be5db758e9717 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -276,12 +276,15 @@ void ProcedureRef::DetermineCopyInOut() { if (!procInfo) { return; } - // TODO: at this point have dummy arguments as procInfo->dummyArguments - // and have actual arguments via arguments_ - - // TODO: implicitly declared procedure may not have any information about - // its dummy args. Handle this case. - + if (!procInfo->HasExplicitInterface()) { + for (auto &actual : arguments_) { + if (!actual) { + continue; + } + DetermineCopyInOutArgument(*procInfo, *actual); + } + return; + } // Don't change anything about actual or dummy arguments, except for // computing copy-in/copy-out information. If detect something wrong with // the arguments, stop processing and let semantic analysis generate the @@ -308,7 +311,13 @@ void ProcedureRef::DetermineCopyInOut() { } else { processedKeywords.insert(actualName); - + if (auto it = std::find_if(procInfo->dummyArguments.begin(), + procInfo->dummyArguments.end(), + [&](const characteristics::DummyArgument &dummy) { + return dummy.name == actualName; + }); it != procInfo->dummyArguments.end()) { + DetermineCopyInOutArgument(*procInfo, *actual, *it); + } } } else if (seenKeyword) { @@ -318,6 +327,8 @@ void ProcedureRef::DetermineCopyInOut() { } else { // Positional argument processing + DetermineCopyInOutArgument(*procInfo, *actual, + procInfo->dummyArguments[index]); } ++index; From 0378a5f48279171a255c102c9c4b1401a2875161 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Sun, 3 Aug 2025 13:05:00 -0400 Subject: [PATCH 10/79] clang-format --- flang/lib/Evaluate/call.cpp | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index be5db758e9717..d8663d137e958 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -312,10 +312,11 @@ void ProcedureRef::DetermineCopyInOut() { else { processedKeywords.insert(actualName); if (auto it = std::find_if(procInfo->dummyArguments.begin(), - procInfo->dummyArguments.end(), - [&](const characteristics::DummyArgument &dummy) { - return dummy.name == actualName; - }); it != procInfo->dummyArguments.end()) { + procInfo->dummyArguments.end(), + [&](const characteristics::DummyArgument &dummy) { + return dummy.name == actualName; + }); + it != procInfo->dummyArguments.end()) { DetermineCopyInOutArgument(*procInfo, *actual, *it); } } @@ -327,8 +328,8 @@ void ProcedureRef::DetermineCopyInOut() { } else { // Positional argument processing - DetermineCopyInOutArgument(*procInfo, *actual, - procInfo->dummyArguments[index]); + DetermineCopyInOutArgument( + *procInfo, *actual, procInfo->dummyArguments[index]); } ++index; From 5d5418a6add0e279870ba05be44b9a3e5dd3ee6d Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Sun, 3 Aug 2025 13:05:50 -0400 Subject: [PATCH 11/79] clang-format --- flang/lib/Evaluate/call.cpp | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index d8663d137e958..10920a4cf6b2f 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -258,11 +258,10 @@ static void DetermineCopyInOutArgument( } static void DetermineCopyInOutArgument( - const characteristics::Procedure &procInfo, - ActualArgument &actual, characteristics::DummyArgument &dummy) { + const characteristics::Procedure &procInfo, ActualArgument &actual, + characteristics::DummyArgument &dummy) { // TODO: assert? procInfo.HasExplicitInterface() - } void ProcedureRef::DetermineCopyInOut() { @@ -308,8 +307,7 @@ void ProcedureRef::DetermineCopyInOut() { // Actual arguments with duplicate keywords. Semantic analysis will // deal with the error. return; - } - else { + } else { processedKeywords.insert(actualName); if (auto it = std::find_if(procInfo->dummyArguments.begin(), procInfo->dummyArguments.end(), @@ -320,13 +318,11 @@ void ProcedureRef::DetermineCopyInOut() { DetermineCopyInOutArgument(*procInfo, *actual, *it); } } - } - else if (seenKeyword) { + } else if (seenKeyword) { // Non-keyword actual argument after have seen at least one keyword // actual argument. Semantic analysis will deal with the error. return; - } - else { + } else { // Positional argument processing DetermineCopyInOutArgument( *procInfo, *actual, procInfo->dummyArguments[index]); From 2cce4bba70f2ce3ad8f331601fc35a317468f5e2 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Sun, 3 Aug 2025 13:06:10 -0400 Subject: [PATCH 12/79] clang-format --- flang/include/flang/Evaluate/call.h | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h index 3d4f791380fba..ac11527e4ecaa 100644 --- a/flang/include/flang/Evaluate/call.h +++ b/flang/include/flang/Evaluate/call.h @@ -248,8 +248,7 @@ class ProcedureRef { ProcedureRef(ProcedureDesignator &&p, ActualArguments &&a, bool hasAlternateReturns = false) : proc_{std::move(p)}, arguments_{std::move(a)}, - hasAlternateReturns_{hasAlternateReturns} { - } + hasAlternateReturns_{hasAlternateReturns} {} ~ProcedureRef(); static void Deleter(ProcedureRef *); From de06d25274f168993def6ba1bc3a28017ad68975 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Wed, 6 Aug 2025 22:10:30 -0400 Subject: [PATCH 13/79] Initial implementation of DetermineCopyInOutArgument() for implicit interfaces. Certain helper routines gained overloads to work with ActualArgument. --- .../include/flang/Evaluate/check-expression.h | 3 ++ flang/include/flang/Evaluate/tools.h | 1 + flang/lib/Evaluate/call.cpp | 45 ++++++++++++++----- flang/lib/Evaluate/check-expression.cpp | 11 +++++ flang/lib/Evaluate/tools.cpp | 5 +++ 5 files changed, 54 insertions(+), 11 deletions(-) diff --git a/flang/include/flang/Evaluate/check-expression.h b/flang/include/flang/Evaluate/check-expression.h index 0cf12f340ec5c..46b91cd2f93cc 100644 --- a/flang/include/flang/Evaluate/check-expression.h +++ b/flang/include/flang/Evaluate/check-expression.h @@ -118,6 +118,9 @@ std::optional IsContiguous(const A &, FoldingContext &, extern template std::optional IsContiguous(const Expr &, FoldingContext &, bool namedConstantSectionsAreContiguous, bool firstDimensionStride1); +extern template std::optional IsContiguous(const ActualArgument &, + FoldingContext &, bool namedConstantSectionsAreContiguous, + bool firstDimensionStride1); extern template std::optional IsContiguous(const ArrayRef &, FoldingContext &, bool namedConstantSectionsAreContiguous, bool firstDimensionStride1); diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h index 212356136d6ee..0be3f66321e4f 100644 --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -1123,6 +1123,7 @@ extern template semantics::UnorderedSymbolSet CollectCudaSymbols( // Predicate: does a variable contain a vector-valued subscript (not a triplet)? bool HasVectorSubscript(const Expr &); +bool HasVectorSubscript(const ActualArgument &); // Predicate: does an expression contain constant? bool HasConstant(const Expr &); diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index 10920a4cf6b2f..365e98a7d800f 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -251,17 +251,39 @@ void ProcedureRef::Deleter(ProcedureRef *p) { delete p; } // We don't know the dummy argument info (e.g., procedure with implicit // interface static void DetermineCopyInOutArgument( - const characteristics::Procedure &procInfo, ActualArgument &actual) { - - // Only check that actual argument is contiguous - // For non-contiguous, do copy-in + const characteristics::Procedure &procInfo, ActualArgument &actual, + semantics::SemanticsContext &sc) { + if (actual.isAlternateReturn()) { + return; + } + if (!evaluate::IsVariable(actual)) { + // Actual argument expressions that aren’t variables are copy-in, but + // not copy-out. + actual.set_mayNeedCopyIn(); + } + else if (!IsSimplyContiguous(actual, sc.foldingContext())) { + // Actual arguments that are variables are copy-in when non-contiguous. + // They are copy-out when don't have vector subscripts + actual.set_mayNeedCopyIn(); + if (!HasVectorSubscript(actual)) { + actual.set_mayNeedCopyOut(); + } + } + else if (ExtractCoarrayRef(actual)) { + // Coindexed actual args need copy-in and copy-out + actual.set_mayNeedCopyIn(); + actual.set_mayNeedCopyOut(); + } } static void DetermineCopyInOutArgument( const characteristics::Procedure &procInfo, ActualArgument &actual, - characteristics::DummyArgument &dummy) { - - // TODO: assert? procInfo.HasExplicitInterface() + characteristics::DummyArgument &dummy, semantics::SemanticsContext &sc) { + assert(procInfo.HasExplicitInterface() && "expect explicit interface proc"); + if (actual.isAlternateReturn()) { + return; + } + // TODO } void ProcedureRef::DetermineCopyInOut() { @@ -269,7 +291,8 @@ void ProcedureRef::DetermineCopyInOut() { return; } // Get folding context of the call site owner - FoldingContext &fc{proc_.GetSymbol()->owner().context().foldingContext()}; + semantics::SemanticsContext &sc{proc_.GetSymbol()->owner().context()}; + FoldingContext &fc{sc.foldingContext()}; auto procInfo{ characteristics::Procedure::Characterize(proc_, fc, /*emitError=*/true)}; if (!procInfo) { @@ -280,7 +303,7 @@ void ProcedureRef::DetermineCopyInOut() { if (!actual) { continue; } - DetermineCopyInOutArgument(*procInfo, *actual); + DetermineCopyInOutArgument(*procInfo, *actual, sc); } return; } @@ -315,7 +338,7 @@ void ProcedureRef::DetermineCopyInOut() { return dummy.name == actualName; }); it != procInfo->dummyArguments.end()) { - DetermineCopyInOutArgument(*procInfo, *actual, *it); + DetermineCopyInOutArgument(*procInfo, *actual, *it, sc); } } } else if (seenKeyword) { @@ -325,7 +348,7 @@ void ProcedureRef::DetermineCopyInOut() { } else { // Positional argument processing DetermineCopyInOutArgument( - *procInfo, *actual, procInfo->dummyArguments[index]); + *procInfo, *actual, procInfo->dummyArguments[index], sc); } ++index; diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index 3d7f01d56c465..eddccc57885e3 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1198,9 +1198,20 @@ std::optional IsContiguous(const A &x, FoldingContext &context, } } +std::optional IsContiguous(const ActualArgument &actual, + FoldingContext &fc, bool namedConstantSectionsAreContiguous, + bool firstDimensionStride1) { + auto *expr{actual.UnwrapExpr()}; + return expr && IsContiguous(*expr, fc, namedConstantSectionsAreContiguous, + firstDimensionStride1); +} + template std::optional IsContiguous(const Expr &, FoldingContext &, bool namedConstantSectionsAreContiguous, bool firstDimensionStride1); +template std::optional IsContiguous(const ActualArgument &, + FoldingContext &, bool namedConstantSectionsAreContiguous, + bool firstDimensionStride1); template std::optional IsContiguous(const ArrayRef &, FoldingContext &, bool namedConstantSectionsAreContiguous, bool firstDimensionStride1); template std::optional IsContiguous(const Substring &, FoldingContext &, diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp index 9c059b08dd41c..3ac605d650b9f 100644 --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -1203,6 +1203,11 @@ bool HasVectorSubscript(const Expr &expr) { return HasVectorSubscriptHelper{}(expr); } +bool HasVectorSubscript(const ActualArgument &actual) { + auto expr = actual.UnwrapExpr(); + return expr && HasVectorSubscript(*expr); +} + // HasConstant() struct HasConstantHelper : public AnyTraverse { From cf42b128d0d3b679e338c7719883a82a9e659272 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Wed, 6 Aug 2025 22:16:38 -0400 Subject: [PATCH 14/79] Removed empty line --- flang/lib/Evaluate/call.cpp | 1 - 1 file changed, 1 deletion(-) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index 365e98a7d800f..21117893f7698 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -350,7 +350,6 @@ void ProcedureRef::DetermineCopyInOut() { DetermineCopyInOutArgument( *procInfo, *actual, procInfo->dummyArguments[index], sc); } - ++index; } } From 9373b90cb8fe1406dc4abf98869a9a511d3ed01c Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Wed, 6 Aug 2025 22:17:39 -0400 Subject: [PATCH 15/79] clang-format --- flang/lib/Evaluate/call.cpp | 6 ++---- flang/lib/Evaluate/check-expression.cpp | 5 +++-- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index 21117893f7698..05fb29174e90e 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -260,16 +260,14 @@ static void DetermineCopyInOutArgument( // Actual argument expressions that aren’t variables are copy-in, but // not copy-out. actual.set_mayNeedCopyIn(); - } - else if (!IsSimplyContiguous(actual, sc.foldingContext())) { + } else if (!IsSimplyContiguous(actual, sc.foldingContext())) { // Actual arguments that are variables are copy-in when non-contiguous. // They are copy-out when don't have vector subscripts actual.set_mayNeedCopyIn(); if (!HasVectorSubscript(actual)) { actual.set_mayNeedCopyOut(); } - } - else if (ExtractCoarrayRef(actual)) { + } else if (ExtractCoarrayRef(actual)) { // Coindexed actual args need copy-in and copy-out actual.set_mayNeedCopyIn(); actual.set_mayNeedCopyOut(); diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index eddccc57885e3..13bc4d4a05ab9 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1202,8 +1202,9 @@ std::optional IsContiguous(const ActualArgument &actual, FoldingContext &fc, bool namedConstantSectionsAreContiguous, bool firstDimensionStride1) { auto *expr{actual.UnwrapExpr()}; - return expr && IsContiguous(*expr, fc, namedConstantSectionsAreContiguous, - firstDimensionStride1); + return expr && + IsContiguous( + *expr, fc, namedConstantSectionsAreContiguous, firstDimensionStride1); } template std::optional IsContiguous(const Expr &, From 12ca5a8103c56d9fe2ca2c686226482469bd821f Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Fri, 8 Aug 2025 10:34:50 -0400 Subject: [PATCH 16/79] Braces! --- flang/lib/Evaluate/call.cpp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index 05fb29174e90e..592663323aa1f 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -323,18 +323,18 @@ void ProcedureRef::DetermineCopyInOut() { } if (actual->keyword()) { seenKeyword = true; - auto actualName = actual->keyword()->ToString(); + auto actualName{actual->keyword()->ToString()}; if (processedKeywords.find(actualName) != processedKeywords.end()) { // Actual arguments with duplicate keywords. Semantic analysis will // deal with the error. return; } else { processedKeywords.insert(actualName); - if (auto it = std::find_if(procInfo->dummyArguments.begin(), + if (auto it{std::find_if(procInfo->dummyArguments.begin(), procInfo->dummyArguments.end(), [&](const characteristics::DummyArgument &dummy) { return dummy.name == actualName; - }); + })}; it != procInfo->dummyArguments.end()) { DetermineCopyInOutArgument(*procInfo, *actual, *it, sc); } From 143f7bd095ff24dd723e34b52f62a8b2cfb618f3 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Fri, 8 Aug 2025 16:02:46 -0400 Subject: [PATCH 17/79] clang-format --- flang/lib/Evaluate/call.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index 592663323aa1f..cd48be276e94b 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -323,7 +323,7 @@ void ProcedureRef::DetermineCopyInOut() { } if (actual->keyword()) { seenKeyword = true; - auto actualName{actual->keyword()->ToString()}; + auto actualName{actual->keyword()->ToString()}; if (processedKeywords.find(actualName) != processedKeywords.end()) { // Actual arguments with duplicate keywords. Semantic analysis will // deal with the error. From 6d0935cf8091a59c0736cf95ec60fd4bfae791d3 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Mon, 11 Aug 2025 15:39:47 -0400 Subject: [PATCH 18/79] Renamed copy-in/copy-out getter/setter functions --- flang/include/flang/Evaluate/call.h | 8 ++++---- flang/lib/Evaluate/call.cpp | 10 +++++----- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h index ac11527e4ecaa..efdcee709d435 100644 --- a/flang/include/flang/Evaluate/call.h +++ b/flang/include/flang/Evaluate/call.h @@ -161,15 +161,15 @@ class ActualArgument { } // This actual argument may need copy-in before the procedure call - bool mayNeedCopyIn() const { return attrs_.test(Attr::CopyIn); }; - ActualArgument &set_mayNeedCopyIn() { + bool GetMayNeedCopyIn() const { return attrs_.test(Attr::CopyIn); }; + ActualArgument &SetMayNeedCopyIn() { attrs_ = attrs_ + Attr::CopyIn; return *this; } // This actual argument may need copy-out after the procedure call - bool mayNeedCopyOut() const { return attrs_.test(Attr::CopyOut); }; - ActualArgument &set_mayNeedCopyOut() { + bool GetMayNeedCopyOut() const { return attrs_.test(Attr::CopyOut); }; + ActualArgument &SetMayNeedCopyOut() { attrs_ = attrs_ + Attr::CopyOut; return *this; } diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index cd48be276e94b..3384563912720 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -259,18 +259,18 @@ static void DetermineCopyInOutArgument( if (!evaluate::IsVariable(actual)) { // Actual argument expressions that aren’t variables are copy-in, but // not copy-out. - actual.set_mayNeedCopyIn(); + actual.SetMayNeedCopyIn(); } else if (!IsSimplyContiguous(actual, sc.foldingContext())) { // Actual arguments that are variables are copy-in when non-contiguous. // They are copy-out when don't have vector subscripts - actual.set_mayNeedCopyIn(); + actual.SetMayNeedCopyIn(); if (!HasVectorSubscript(actual)) { - actual.set_mayNeedCopyOut(); + actual.SetMayNeedCopyOut(); } } else if (ExtractCoarrayRef(actual)) { // Coindexed actual args need copy-in and copy-out - actual.set_mayNeedCopyIn(); - actual.set_mayNeedCopyOut(); + actual.SetMayNeedCopyIn(); + actual.SetMayNeedCopyOut(); } } From 15db3f8db3769340527262f61098f61933e515c0 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Mon, 11 Aug 2025 20:08:32 -0400 Subject: [PATCH 19/79] Contiguity check --- flang/lib/Evaluate/call.cpp | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index 3384563912720..aab2d3607eb9d 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -281,6 +281,16 @@ static void DetermineCopyInOutArgument( if (actual.isAlternateReturn()) { return; } + const auto *dummyObj = std::get_if(&dummy.u); + if (!dummyObj) { + // Only DummyDataObject has the information we need + return; + } + // Check actual contiguity, unless dummy doesn't care + bool actualContiguous = dummyObj->ignoreTKR.test(common::IgnoreTKR::Contiguous) + || IsSimplyContiguous(actual, sc.foldingContext()); + bool actualVectorSubscript = HasVectorSubscript(actual); + // TODO } From 58764a61ce508d1246e862097258d4b4f2c31800 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Tue, 12 Aug 2025 11:33:52 -0400 Subject: [PATCH 20/79] clang-format --- flang/lib/Evaluate/call.cpp | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index aab2d3607eb9d..4e054d7e51cbd 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -281,14 +281,16 @@ static void DetermineCopyInOutArgument( if (actual.isAlternateReturn()) { return; } - const auto *dummyObj = std::get_if(&dummy.u); + const auto *dummyObj = + std::get_if(&dummy.u); if (!dummyObj) { // Only DummyDataObject has the information we need return; } // Check actual contiguity, unless dummy doesn't care - bool actualContiguous = dummyObj->ignoreTKR.test(common::IgnoreTKR::Contiguous) - || IsSimplyContiguous(actual, sc.foldingContext()); + bool actualContiguous = + dummyObj->ignoreTKR.test(common::IgnoreTKR::Contiguous) || + IsSimplyContiguous(actual, sc.foldingContext()); bool actualVectorSubscript = HasVectorSubscript(actual); // TODO From eb27031929e7c1d8f712cacd8ff189d54bdbb334 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Tue, 12 Aug 2025 13:41:37 -0400 Subject: [PATCH 21/79] Continue filling out DetermineCopyInOutArgument(). Implemented IsExplicitShape(const Shape&) --- flang/include/flang/Evaluate/shape.h | 1 + flang/lib/Evaluate/call.cpp | 36 ++++++++++++++++++++++++---- flang/lib/Evaluate/shape.cpp | 11 +++++++++ 3 files changed, 43 insertions(+), 5 deletions(-) diff --git a/flang/include/flang/Evaluate/shape.h b/flang/include/flang/Evaluate/shape.h index f0505cfcdf2d7..32fcdc0281f26 100644 --- a/flang/include/flang/Evaluate/shape.h +++ b/flang/include/flang/Evaluate/shape.h @@ -35,6 +35,7 @@ using Shape = std::vector; bool IsImpliedShape(const Symbol &); bool IsExplicitShape(const Symbol &); +bool IsExplicitShape(const Shape &); // Conversions between various representations of shapes. std::optional AsExtentArrayExpr(const Shape &); diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index 4e054d7e51cbd..d91eb998d88b0 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -281,17 +281,43 @@ static void DetermineCopyInOutArgument( if (actual.isAlternateReturn()) { return; } - const auto *dummyObj = - std::get_if(&dummy.u); + const auto *dummyObj{ + std::get_if(&dummy.u)}; if (!dummyObj) { // Only DummyDataObject has the information we need return; } + + bool dummyIsValue{ + dummyObj->attrs.test(characteristics::DummyDataObject::Attr::Value)}; + if (dummyIsValue) { + actual.SetMayNeedCopyIn(); + return; + } + // Check actual contiguity, unless dummy doesn't care - bool actualContiguous = + bool actualTreatAsContiguous{ dummyObj->ignoreTKR.test(common::IgnoreTKR::Contiguous) || - IsSimplyContiguous(actual, sc.foldingContext()); - bool actualVectorSubscript = HasVectorSubscript(actual); + IsSimplyContiguous(actual, sc.foldingContext())}; + + bool actualHasVectorSubscript{HasVectorSubscript(actual)}; + bool actualIsArray{actual.Rank() > 0}; + + bool dummyIsArray{dummyObj->type.Rank() > 0}; + bool dummyIsExplicitShape{ + dummyIsArray ? IsExplicitShape(*dummyObj->type.shape()) : false}; + bool dummyIsAssumedSize{dummyObj->type.attrs().test( + characteristics::TypeAndShape::Attr::AssumedSize)}; + bool dummyNeedsContiguity{dummyIsArray && + (dummyIsExplicitShape || dummyIsAssumedSize || + dummyObj->attrs.test(characteristics::DummyDataObject::Attr::Contiguous))}; + if (!actualTreatAsContiguous && dummyNeedsContiguity) { + actual.SetMayNeedCopyIn(); + if (!actualHasVectorSubscript) { + actual.SetMayNeedCopyOut(); + } + } + // TODO } diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp index 776866d1416d2..2c0191e866d3f 100644 --- a/flang/lib/Evaluate/shape.cpp +++ b/flang/lib/Evaluate/shape.cpp @@ -47,6 +47,17 @@ bool IsExplicitShape(const Symbol &original) { } } +bool IsExplicitShape(const Shape &shape) { + // If extent expression is present for all dimensions, then assume + // explicit shape. + for (const auto &dim : shape) { + if (!dim) { + return false; + } + } + return true; +} + Shape GetShapeHelper::ConstantShape(const Constant &arrayConstant) { CHECK(arrayConstant.Rank() == 1); Shape result; From 3ec01ad3b840e89f768d489a8cd5459196e1d166 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Tue, 12 Aug 2025 13:42:07 -0400 Subject: [PATCH 22/79] clang-format --- flang/lib/Evaluate/call.cpp | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index d91eb998d88b0..a07f57b43ccee 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -281,8 +281,7 @@ static void DetermineCopyInOutArgument( if (actual.isAlternateReturn()) { return; } - const auto *dummyObj{ - std::get_if(&dummy.u)}; + const auto *dummyObj{std::get_if(&dummy.u)}; if (!dummyObj) { // Only DummyDataObject has the information we need return; @@ -310,7 +309,8 @@ static void DetermineCopyInOutArgument( characteristics::TypeAndShape::Attr::AssumedSize)}; bool dummyNeedsContiguity{dummyIsArray && (dummyIsExplicitShape || dummyIsAssumedSize || - dummyObj->attrs.test(characteristics::DummyDataObject::Attr::Contiguous))}; + dummyObj->attrs.test( + characteristics::DummyDataObject::Attr::Contiguous))}; if (!actualTreatAsContiguous && dummyNeedsContiguity) { actual.SetMayNeedCopyIn(); if (!actualHasVectorSubscript) { @@ -318,7 +318,6 @@ static void DetermineCopyInOutArgument( } } - // TODO } From 889d514e02d05ce27df80e41e8640f21370432d6 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Tue, 12 Aug 2025 16:40:12 -0400 Subject: [PATCH 23/79] In DetermineCopyInOutArgument(), handle INTENT(IN) and INTENT(OUT) --- flang/lib/Evaluate/call.cpp | 24 +++++++++++++++++++++--- 1 file changed, 21 insertions(+), 3 deletions(-) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index a07f57b43ccee..6a69223725b28 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -286,13 +286,28 @@ static void DetermineCopyInOutArgument( // Only DummyDataObject has the information we need return; } - + // Pass by value, always copy-in, never copy-out bool dummyIsValue{ dummyObj->attrs.test(characteristics::DummyDataObject::Attr::Value)}; if (dummyIsValue) { actual.SetMayNeedCopyIn(); return; } + bool dummyIntentIn{dummyObj->intent == common::Intent::In}; + bool dummyIntentOut{dummyObj->intent == common::Intent::Out}; + + auto setCopyIn = [&]() { + if (!dummyIntentOut) { + // INTENT(OUT) never need copy-in + actual.SetMayNeedCopyIn(); + } + }; + auto setCopyOut = [&]() { + if (!dummyIntentIn) { + // INTENT(IN) never need copy-out + actual.SetMayNeedCopyOut(); + } + }; // Check actual contiguity, unless dummy doesn't care bool actualTreatAsContiguous{ @@ -312,12 +327,15 @@ static void DetermineCopyInOutArgument( dummyObj->attrs.test( characteristics::DummyDataObject::Attr::Contiguous))}; if (!actualTreatAsContiguous && dummyNeedsContiguity) { - actual.SetMayNeedCopyIn(); + setCopyIn(); if (!actualHasVectorSubscript) { - actual.SetMayNeedCopyOut(); + setCopyOut(); } + return; } + // TODO: passing polymorphic to non-polymorphic + // TODO } From 068216fadaea846648a11b5668446f16b5d7f798 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Wed, 13 Aug 2025 18:26:04 -0400 Subject: [PATCH 24/79] Support polymorphic-to-non-polymorphic case. Initial hookup into lowering, have LIT test failures --- flang/lib/Evaluate/call.cpp | 32 ++++++++++++++++++++++++++++---- flang/lib/Lower/ConvertCall.cpp | 14 ++++++++++++-- 2 files changed, 40 insertions(+), 6 deletions(-) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index 6a69223725b28..e3119350a2252 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -260,7 +260,8 @@ static void DetermineCopyInOutArgument( // Actual argument expressions that aren’t variables are copy-in, but // not copy-out. actual.SetMayNeedCopyIn(); - } else if (!IsSimplyContiguous(actual, sc.foldingContext())) { + } else if (bool actualIsArray{actual.Rank() > 0}; actualIsArray && + !IsSimplyContiguous(actual, sc.foldingContext())) { // Actual arguments that are variables are copy-in when non-contiguous. // They are copy-out when don't have vector subscripts actual.SetMayNeedCopyIn(); @@ -281,6 +282,12 @@ static void DetermineCopyInOutArgument( if (actual.isAlternateReturn()) { return; } + if (!evaluate::IsVariable(actual)) { + // Actual argument expressions that aren’t variables are copy-in, but + // not copy-out. + actual.SetMayNeedCopyIn(); + return; + } const auto *dummyObj{std::get_if(&dummy.u)}; if (!dummyObj) { // Only DummyDataObject has the information we need @@ -309,13 +316,17 @@ static void DetermineCopyInOutArgument( } }; + bool actualIsArray{actual.Rank() > 0}; + if (!actualIsArray) { + return; + } + // Check actual contiguity, unless dummy doesn't care bool actualTreatAsContiguous{ dummyObj->ignoreTKR.test(common::IgnoreTKR::Contiguous) || IsSimplyContiguous(actual, sc.foldingContext())}; bool actualHasVectorSubscript{HasVectorSubscript(actual)}; - bool actualIsArray{actual.Rank() > 0}; bool dummyIsArray{dummyObj->type.Rank() > 0}; bool dummyIsExplicitShape{ @@ -328,15 +339,28 @@ static void DetermineCopyInOutArgument( characteristics::DummyDataObject::Attr::Contiguous))}; if (!actualTreatAsContiguous && dummyNeedsContiguity) { setCopyIn(); + // Cannot do copy-out for vector subscripts: there could be repeated + // indices, for example if (!actualHasVectorSubscript) { setCopyOut(); } return; } - // TODO: passing polymorphic to non-polymorphic + 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. + auto actualType{characteristics::TypeAndShape::Characterize( + actual, sc.foldingContext())}; + bool actualIsPolymorphic{actualType->type().IsPolymorphic()}; + bool dummyIsPolymorphic{dummyObj->type.type().IsPolymorphic()}; + if (actualIsPolymorphic && !dummyIsPolymorphic) { + setCopyIn(); + setCopyOut(); + } + } - // TODO + // TODO: character type differences? } void ProcedureRef::DetermineCopyInOut() { diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index bf713f5a0bc48..729b2e95a5397 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1257,10 +1257,19 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( // The simple contiguity of the actual is "lost" when passing a polymorphic // to a non polymorphic entity because the dummy dynamic type matters for // the contiguity. +#if 0 const bool mustDoCopyInOut = actual.isArray() && arg.mustBeMadeContiguous() && (passingPolymorphicToNonPolymorphic || !isSimplyContiguous(*arg.entity, foldingContext)); +#else + bool mustDoCopyIn = false; + bool mustDoCopyOut = false; + if constexpr (std::is_same_v) { + mustDoCopyIn = arg.entity->GetMayNeedCopyIn(); + mustDoCopyIn = arg.entity->GetMayNeedCopyOut(); + } +#endif const bool actualIsAssumedRank = actual.isAssumedRank(); // Create dummy type with actual argument rank when the dummy is an assumed @@ -1370,7 +1379,7 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( entity = hlfir::Entity{associate.getBase()}; // Register the temporary destruction after the call. preparedDummy.pushExprAssociateCleanUp(associate); - } else if (mustDoCopyInOut) { + } else if (mustDoCopyIn) { // Copy-in non contiguous variables. // TODO: for non-finalizable monomorphic derived type actual // arguments associated with INTENT(OUT) dummy arguments @@ -1379,7 +1388,8 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( // allocation for the temp in this case. We can communicate // this to the codegen via some CopyInOp flag. // This is a performance concern. - entity = genCopyIn(entity, arg.mayBeModifiedByCall()); + //entity = genCopyIn(entity, arg.mayBeModifiedByCall()); + entity = genCopyIn(entity, mustDoCopyOut); } } else { const Fortran::lower::SomeExpr *expr = arg.entity->UnwrapExpr(); From 3f36c9fb0ccd3e7b70009193b57f7200898edbe9 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Wed, 13 Aug 2025 18:26:35 -0400 Subject: [PATCH 25/79] clang-format --- flang/lib/Evaluate/call.cpp | 2 +- flang/lib/Lower/ConvertCall.cpp | 5 +++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index e3119350a2252..efaa3bd42a310 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -261,7 +261,7 @@ static void DetermineCopyInOutArgument( // not copy-out. actual.SetMayNeedCopyIn(); } else if (bool actualIsArray{actual.Rank() > 0}; actualIsArray && - !IsSimplyContiguous(actual, sc.foldingContext())) { + !IsSimplyContiguous(actual, sc.foldingContext())) { // Actual arguments that are variables are copy-in when non-contiguous. // They are copy-out when don't have vector subscripts actual.SetMayNeedCopyIn(); diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index 729b2e95a5397..85ac5c2539cc8 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1265,7 +1265,8 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( #else bool mustDoCopyIn = false; bool mustDoCopyOut = false; - if constexpr (std::is_same_v) { + if constexpr (std::is_same_v) { mustDoCopyIn = arg.entity->GetMayNeedCopyIn(); mustDoCopyIn = arg.entity->GetMayNeedCopyOut(); } @@ -1388,7 +1389,7 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( // allocation for the temp in this case. We can communicate // this to the codegen via some CopyInOp flag. // This is a performance concern. - //entity = genCopyIn(entity, arg.mayBeModifiedByCall()); + // entity = genCopyIn(entity, arg.mayBeModifiedByCall()); entity = genCopyIn(entity, mustDoCopyOut); } } else { From 070ffd1e80ded417d0ea8eac6c478f078f7fddf7 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Wed, 13 Aug 2025 22:35:21 -0400 Subject: [PATCH 26/79] array check --- flang/lib/Lower/ConvertCall.cpp | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index 85ac5c2539cc8..003eb78093f8b 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1265,9 +1265,8 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( #else bool mustDoCopyIn = false; bool mustDoCopyOut = false; - if constexpr (std::is_same_v) { - mustDoCopyIn = arg.entity->GetMayNeedCopyIn(); + if constexpr (std::is_same_v) { + mustDoCopyIn = actual.isArray() && arg.entity->GetMayNeedCopyIn(); mustDoCopyIn = arg.entity->GetMayNeedCopyOut(); } #endif From 50622660e61229afcb4fdcf097e9026b6cfe4f93 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Wed, 13 Aug 2025 22:35:38 -0400 Subject: [PATCH 27/79] array check --- flang/lib/Lower/ConvertCall.cpp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index 003eb78093f8b..cdbc3ee259815 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1265,7 +1265,8 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( #else bool mustDoCopyIn = false; bool mustDoCopyOut = false; - if constexpr (std::is_same_v) { + if constexpr (std::is_same_v) { mustDoCopyIn = actual.isArray() && arg.entity->GetMayNeedCopyIn(); mustDoCopyIn = arg.entity->GetMayNeedCopyOut(); } From 312cf2580f652f87b8d0269f31e94165b4633dee Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Thu, 14 Aug 2025 19:04:55 -0400 Subject: [PATCH 28/79] Changed IsExplicitShape() and restructured the checks --- .../include/flang/Evaluate/characteristics.h | 6 ++++ flang/include/flang/Evaluate/shape.h | 1 - flang/lib/Evaluate/call.cpp | 29 +++++++++---------- flang/lib/Evaluate/shape.cpp | 11 ------- 4 files changed, 20 insertions(+), 27 deletions(-) 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> 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/shape.h b/flang/include/flang/Evaluate/shape.h index 32fcdc0281f26..f0505cfcdf2d7 100644 --- a/flang/include/flang/Evaluate/shape.h +++ b/flang/include/flang/Evaluate/shape.h @@ -35,7 +35,6 @@ using Shape = std::vector; bool IsImpliedShape(const Symbol &); bool IsExplicitShape(const Symbol &); -bool IsExplicitShape(const Shape &); // Conversions between various representations of shapes. std::optional AsExtentArrayExpr(const Shape &); diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index efaa3bd42a310..888522577022c 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -300,6 +300,13 @@ static void DetermineCopyInOutArgument( actual.SetMayNeedCopyIn(); return; } + // All the checks below are for arrays + bool actualIsArray{actual.Rank() > 0}; + bool dummyIsArray{dummyObj->type.Rank() > 0}; + if (!actualIsArray || !dummyIsArray) { + return; + } + bool dummyIntentIn{dummyObj->intent == common::Intent::In}; bool dummyIntentOut{dummyObj->intent == common::Intent::Out}; @@ -316,27 +323,17 @@ static void DetermineCopyInOutArgument( } }; - bool actualIsArray{actual.Rank() > 0}; - if (!actualIsArray) { - return; - } - // Check actual contiguity, unless dummy doesn't care bool actualTreatAsContiguous{ dummyObj->ignoreTKR.test(common::IgnoreTKR::Contiguous) || IsSimplyContiguous(actual, sc.foldingContext())}; - bool actualHasVectorSubscript{HasVectorSubscript(actual)}; - - bool dummyIsArray{dummyObj->type.Rank() > 0}; - bool dummyIsExplicitShape{ - dummyIsArray ? IsExplicitShape(*dummyObj->type.shape()) : false}; + bool dummyIsExplicitShape{dummyObj->type.IsExplicitShape()}; bool dummyIsAssumedSize{dummyObj->type.attrs().test( characteristics::TypeAndShape::Attr::AssumedSize)}; - bool dummyNeedsContiguity{dummyIsArray && - (dummyIsExplicitShape || dummyIsAssumedSize || - dummyObj->attrs.test( - characteristics::DummyDataObject::Attr::Contiguous))}; + bool dummyNeedsContiguity{dummyIsExplicitShape || dummyIsAssumedSize || + dummyObj->attrs.test( + characteristics::DummyDataObject::Attr::Contiguous)}; if (!actualTreatAsContiguous && dummyNeedsContiguity) { setCopyIn(); // Cannot do copy-out for vector subscripts: there could be repeated @@ -349,7 +346,9 @@ static void DetermineCopyInOutArgument( 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. + // 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.) auto actualType{characteristics::TypeAndShape::Characterize( actual, sc.foldingContext())}; bool actualIsPolymorphic{actualType->type().IsPolymorphic()}; diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp index 2c0191e866d3f..776866d1416d2 100644 --- a/flang/lib/Evaluate/shape.cpp +++ b/flang/lib/Evaluate/shape.cpp @@ -47,17 +47,6 @@ bool IsExplicitShape(const Symbol &original) { } } -bool IsExplicitShape(const Shape &shape) { - // If extent expression is present for all dimensions, then assume - // explicit shape. - for (const auto &dim : shape) { - if (!dim) { - return false; - } - } - return true; -} - Shape GetShapeHelper::ConstantShape(const Constant &arrayConstant) { CHECK(arrayConstant.Rank() == 1); Shape result; From bc2e17aedc60dfb389eb726516d969b55c436daa Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Thu, 14 Aug 2025 21:51:25 -0400 Subject: [PATCH 29/79] Redid the integration to basically the old code but debug output with the new code --- flang/include/flang/Lower/CallInterface.h | 2 ++ flang/lib/Evaluate/call.cpp | 7 ++----- flang/lib/Lower/ConvertCall.cpp | 23 ++++++++++++----------- 3 files changed, 16 insertions(+), 16 deletions(-) diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h index 72bc9dd890a94..6e3bdc0d9104c 100644 --- a/flang/include/flang/Lower/CallInterface.h +++ b/flang/include/flang/Lower/CallInterface.h @@ -159,6 +159,8 @@ class CallInterface { /// PassedEntity is what is provided back to the CallInterface user. /// It describe how the entity is plugged in the interface struct PassedEntity { + /// Helps with caller/callee differentiation + static constexpr bool isCaller = std::is_same_v; /// Is the dummy argument optional? bool isOptional() const; /// Can the argument be modified by the callee? diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index 888522577022c..e79a314c837ed 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -309,16 +309,15 @@ static void DetermineCopyInOutArgument( bool dummyIntentIn{dummyObj->intent == common::Intent::In}; bool dummyIntentOut{dummyObj->intent == common::Intent::Out}; - auto setCopyIn = [&]() { if (!dummyIntentOut) { - // INTENT(OUT) never need copy-in + // INTENT(OUT) dummy args never need copy-in actual.SetMayNeedCopyIn(); } }; auto setCopyOut = [&]() { if (!dummyIntentIn) { - // INTENT(IN) never need copy-out + // INTENT(IN) dummy args never need copy-out actual.SetMayNeedCopyOut(); } }; @@ -358,8 +357,6 @@ static void DetermineCopyInOutArgument( setCopyOut(); } } - - // TODO: character type differences? } void ProcedureRef::DetermineCopyInOut() { diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index cdbc3ee259815..368ec1c23da52 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1257,20 +1257,22 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( // The simple contiguity of the actual is "lost" when passing a polymorphic // to a non polymorphic entity because the dummy dynamic type matters for // the contiguity. -#if 0 - const bool mustDoCopyInOut = + bool mustDoCopyIn = actual.isArray() && arg.mustBeMadeContiguous() && (passingPolymorphicToNonPolymorphic || !isSimplyContiguous(*arg.entity, foldingContext)); -#else - bool mustDoCopyIn = false; - bool mustDoCopyOut = false; - if constexpr (std::is_same_v) { - mustDoCopyIn = actual.isArray() && arg.entity->GetMayNeedCopyIn(); - mustDoCopyIn = arg.entity->GetMayNeedCopyOut(); + bool mustDoCopyOut = arg.mayBeModifiedByCall(); + if constexpr (Fortran::lower::CallerInterface::PassedEntity::isCaller) { + bool newMustDoCopyIn = actual.isArray() && arg.entity->GetMayNeedCopyIn(); + bool newMustDoCopyOut = arg.entity->GetMayNeedCopyOut(); + LLVM_DEBUG(llvm::dbgs() << "copyinout: CALLER " << + "copy-in: old=" << mustDoCopyIn << ", new=" << newMustDoCopyIn << + "| copy-out: old=" << mustDoCopyOut << ", new=" << newMustDoCopyOut << + "\n"); + } else { + LLVM_DEBUG(llvm::dbgs() << "copyinout: CALLEE " << + "copy-in=" << mustDoCopyIn << ", copy-out=" << mustDoCopyOut << "\n"); } -#endif const bool actualIsAssumedRank = actual.isAssumedRank(); // Create dummy type with actual argument rank when the dummy is an assumed @@ -1389,7 +1391,6 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( // allocation for the temp in this case. We can communicate // this to the codegen via some CopyInOp flag. // This is a performance concern. - // entity = genCopyIn(entity, arg.mayBeModifiedByCall()); entity = genCopyIn(entity, mustDoCopyOut); } } else { From d026f49b82575c71f0fd377634cd6f502ddf5a10 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Thu, 14 Aug 2025 22:56:34 -0400 Subject: [PATCH 30/79] Tweaks and debug output --- flang/lib/Lower/ConvertCall.cpp | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index 368ec1c23da52..b0b130cce3ecc 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1261,17 +1261,21 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( actual.isArray() && arg.mustBeMadeContiguous() && (passingPolymorphicToNonPolymorphic || !isSimplyContiguous(*arg.entity, foldingContext)); - bool mustDoCopyOut = arg.mayBeModifiedByCall(); + bool mustDoCopyOut = mustDoCopyIn && arg.mayBeModifiedByCall(); if constexpr (Fortran::lower::CallerInterface::PassedEntity::isCaller) { bool newMustDoCopyIn = actual.isArray() && arg.entity->GetMayNeedCopyIn(); bool newMustDoCopyOut = arg.entity->GetMayNeedCopyOut(); - LLVM_DEBUG(llvm::dbgs() << "copyinout: CALLER " << +#if 1 + llvm::dbgs() << "copyinout: CALLER " << "copy-in: old=" << mustDoCopyIn << ", new=" << newMustDoCopyIn << "| copy-out: old=" << mustDoCopyOut << ", new=" << newMustDoCopyOut << - "\n"); + "\n"; +#endif } else { - LLVM_DEBUG(llvm::dbgs() << "copyinout: CALLEE " << - "copy-in=" << mustDoCopyIn << ", copy-out=" << mustDoCopyOut << "\n"); +#if 1 + llvm::dbgs() << "copyinout: CALLEE " << + "copy-in=" << mustDoCopyIn << ", copy-out=" << mustDoCopyOut << "\n"; +#endif } const bool actualIsAssumedRank = actual.isAssumedRank(); From 55b8e0eeb0fc846883b38e78c294ff54801bcd3b Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Thu, 14 Aug 2025 23:33:00 -0400 Subject: [PATCH 31/79] Switched to the new code. 5 failed tests left --- flang/lib/Lower/ConvertCall.cpp | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index b0b130cce3ecc..610dd6315d1f5 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1262,9 +1262,11 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( (passingPolymorphicToNonPolymorphic || !isSimplyContiguous(*arg.entity, foldingContext)); bool mustDoCopyOut = mustDoCopyIn && arg.mayBeModifiedByCall(); + bool newMustDoCopyIn = false; + bool newMustDoCopyOut = false; if constexpr (Fortran::lower::CallerInterface::PassedEntity::isCaller) { - bool newMustDoCopyIn = actual.isArray() && arg.entity->GetMayNeedCopyIn(); - bool newMustDoCopyOut = arg.entity->GetMayNeedCopyOut(); + newMustDoCopyIn = arg.entity->GetMayNeedCopyIn(); + newMustDoCopyOut = arg.entity->GetMayNeedCopyOut(); #if 1 llvm::dbgs() << "copyinout: CALLER " << "copy-in: old=" << mustDoCopyIn << ", new=" << newMustDoCopyIn << @@ -1277,6 +1279,8 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( "copy-in=" << mustDoCopyIn << ", copy-out=" << mustDoCopyOut << "\n"; #endif } + mustDoCopyIn = newMustDoCopyIn; + mustDoCopyOut = newMustDoCopyOut; const bool actualIsAssumedRank = actual.isAssumedRank(); // Create dummy type with actual argument rank when the dummy is an assumed From 258fc64ebbe362d0d724ea9d13ba854ab23eb517 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Fri, 15 Aug 2025 14:25:44 -0400 Subject: [PATCH 32/79] Fixed one issue with assumed rank arrays --- flang/lib/Evaluate/call.cpp | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index e79a314c837ed..ff7f7cde224d3 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -301,8 +301,12 @@ static void DetermineCopyInOutArgument( return; } // All the checks below are for arrays - bool actualIsArray{actual.Rank() > 0}; - bool dummyIsArray{dummyObj->type.Rank() > 0}; + + bool actualIsAssumedRank{evaluate::IsAssumedRank(actual)}; + bool actualIsArray{actualIsAssumedRank || actual.Rank() > 0}; + bool dummyIsAssumedRank{dummyObj->type.attrs().test( + characteristics::TypeAndShape::Attr::AssumedRank)}; + bool dummyIsArray{dummyIsAssumedRank || dummyObj->type.Rank() > 0}; if (!actualIsArray || !dummyIsArray) { return; } From a197190365dd14a2ddcad28c4e070681a4815ab3 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Fri, 15 Aug 2025 15:36:10 -0400 Subject: [PATCH 33/79] clang-format --- flang/lib/Evaluate/call.cpp | 3 +-- flang/lib/Lower/ConvertCall.cpp | 19 +++++++++---------- 2 files changed, 10 insertions(+), 12 deletions(-) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index ff7f7cde224d3..5a8ef8de92305 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -335,8 +335,7 @@ static void DetermineCopyInOutArgument( bool dummyIsAssumedSize{dummyObj->type.attrs().test( characteristics::TypeAndShape::Attr::AssumedSize)}; bool dummyNeedsContiguity{dummyIsExplicitShape || dummyIsAssumedSize || - dummyObj->attrs.test( - characteristics::DummyDataObject::Attr::Contiguous)}; + dummyObj->attrs.test(characteristics::DummyDataObject::Attr::Contiguous)}; if (!actualTreatAsContiguous && dummyNeedsContiguity) { setCopyIn(); // Cannot do copy-out for vector subscripts: there could be repeated diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index 610dd6315d1f5..1d92a634059ea 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1257,10 +1257,9 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( // The simple contiguity of the actual is "lost" when passing a polymorphic // to a non polymorphic entity because the dummy dynamic type matters for // the contiguity. - bool mustDoCopyIn = - actual.isArray() && arg.mustBeMadeContiguous() && - (passingPolymorphicToNonPolymorphic || - !isSimplyContiguous(*arg.entity, foldingContext)); + bool mustDoCopyIn = actual.isArray() && arg.mustBeMadeContiguous() && + (passingPolymorphicToNonPolymorphic || + !isSimplyContiguous(*arg.entity, foldingContext)); bool mustDoCopyOut = mustDoCopyIn && arg.mayBeModifiedByCall(); bool newMustDoCopyIn = false; bool newMustDoCopyOut = false; @@ -1268,15 +1267,15 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( newMustDoCopyIn = arg.entity->GetMayNeedCopyIn(); newMustDoCopyOut = arg.entity->GetMayNeedCopyOut(); #if 1 - llvm::dbgs() << "copyinout: CALLER " << - "copy-in: old=" << mustDoCopyIn << ", new=" << newMustDoCopyIn << - "| copy-out: old=" << mustDoCopyOut << ", new=" << newMustDoCopyOut << - "\n"; + llvm::dbgs() << "copyinout: CALLER " << "copy-in: old=" << mustDoCopyIn + << ", new=" << newMustDoCopyIn + << "| copy-out: old=" << mustDoCopyOut + << ", new=" << newMustDoCopyOut << "\n"; #endif } else { #if 1 - llvm::dbgs() << "copyinout: CALLEE " << - "copy-in=" << mustDoCopyIn << ", copy-out=" << mustDoCopyOut << "\n"; + llvm::dbgs() << "copyinout: CALLEE " << "copy-in=" << mustDoCopyIn + << ", copy-out=" << mustDoCopyOut << "\n"; #endif } mustDoCopyIn = newMustDoCopyIn; From 30d36b0b9644df27d1d248e6d52de6bc45c58442 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Fri, 15 Aug 2025 17:37:24 -0400 Subject: [PATCH 34/79] Expaned IsAssumedShape() checks and moved them to Fortran::evaluate namespace. In DetermineCopyInOutArgument() check for assumed shape and assumed rank --- flang/include/flang/Evaluate/tools.h | 22 +++++++++++++++++++- flang/lib/Evaluate/call.cpp | 9 +++++++- flang/lib/Evaluate/check-expression.cpp | 2 +- flang/lib/Evaluate/tools.cpp | 24 +++++++++++++++------- flang/lib/Lower/ConvertVariable.cpp | 2 +- flang/lib/Semantics/check-call.cpp | 4 ++-- flang/lib/Semantics/check-declarations.cpp | 4 ++-- flang/lib/Semantics/check-omp-loop.cpp | 2 +- flang/lib/Semantics/resolve-directives.cpp | 4 ++-- 9 files changed, 55 insertions(+), 18 deletions(-) diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h index 0be3f66321e4f..95e60379f7e63 100644 --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -103,6 +103,27 @@ template bool IsAssumedRank(const A *x) { return x && IsAssumedRank(*x); } +// Predicate: true when an expression is assumed-shape +bool IsAssumedShape(const Symbol &); +bool IsAssumedShape(const ActualArgument &); +template bool IsAssumedShape(const A &) { return false; } +template bool IsAssumedShape(const Designator &designator) { + if (const auto *symbol{std::get_if(&designator.u)}) { + return evaluate::IsAssumedShape(symbol->get()); + } else { + return false; + } +} +template bool IsAssumedShape(const Expr &expr) { + return common::visit([](const auto &x) { return IsAssumedShape(x); }, expr.u); +} +template bool IsAssumedShape(const std::optional &x) { + return x && IsAssumedShape(*x); +} +template bool IsAssumedShape(const A *x) { + return x && IsAssumedShape(*x); +} + // Finds the corank of an entity, possibly packaged in various ways. // Unlike rank, only data references have corank > 0. int GetCorank(const ActualArgument &); @@ -1549,7 +1570,6 @@ bool IsAllocatableOrObjectPointer(const Symbol *); bool IsAutomatic(const Symbol &); bool IsSaved(const Symbol &); // saved implicitly or explicitly bool IsDummy(const Symbol &); -bool IsAssumedShape(const Symbol &); bool IsDeferredShape(const Symbol &); bool IsFunctionResult(const Symbol &); bool IsKindTypeParameter(const Symbol &); diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index 5a8ef8de92305..90356f6a34fcf 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -346,7 +346,14 @@ static void DetermineCopyInOutArgument( return; } - if (!dummyObj->ignoreTKR.test(common::IgnoreTKR::Type)) { + bool dummyIsAssumedShape{dummyObj->type.attrs().test( + characteristics::TypeAndShape::Attr::AssumedShape)}; + bool actualIsAssumedShape{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, diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index 10361b3b32bc5..d8780c2ca5aa5 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1002,7 +1002,7 @@ class IsContiguousHelper return Base::operator()(ultimate); // use expr } } else if (semantics::IsPointer(ultimate) || - semantics::IsAssumedShape(ultimate) || IsAssumedRank(ultimate)) { + IsAssumedShape(ultimate) || IsAssumedRank(ultimate)) { return std::nullopt; } else if (ultimate.has()) { return true; diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp index 6eb910367e0a1..175f1e4ecfdb1 100644 --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -913,6 +913,23 @@ bool IsAssumedRank(const ActualArgument &arg) { } } +bool IsAssumedShape(const Symbol &symbol) { + const Symbol &ultimate{ResolveAssociations(symbol)}; + const auto *object{ultimate.detailsIf()}; + return object && object->IsAssumedShape() && + !semantics::IsAllocatableOrObjectPointer(&ultimate); +} + +bool IsAssumedShape(const ActualArgument &arg) { + if (const auto *expr{arg.UnwrapExpr()}) { + return IsAssumedShape(*expr); + } else { + const Symbol *assumedTypeDummy{arg.GetAssumedTypeDummy()}; + CHECK(assumedTypeDummy); + return IsAssumedShape(*assumedTypeDummy); + } +} + int GetCorank(const ActualArgument &arg) { const auto *expr{arg.UnwrapExpr()}; return GetCorank(*expr); @@ -2317,13 +2334,6 @@ bool IsDummy(const Symbol &symbol) { ResolveAssociations(symbol).details()); } -bool IsAssumedShape(const Symbol &symbol) { - const Symbol &ultimate{ResolveAssociations(symbol)}; - const auto *object{ultimate.detailsIf()}; - return object && object->IsAssumedShape() && - !semantics::IsAllocatableOrObjectPointer(&ultimate); -} - bool IsDeferredShape(const Symbol &symbol) { const Symbol &ultimate{ResolveAssociations(symbol)}; const auto *object{ultimate.detailsIf()}; diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp index fd66592bc285b..2cd666b85bb21 100644 --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -1111,7 +1111,7 @@ static bool needsRepack(Fortran::lower::AbstractConverter &converter, const auto &attrs = sym.attrs(); if (!converter.getLoweringOptions().getRepackArrays() || !converter.isRegisteredDummySymbol(sym) || - !Fortran::semantics::IsAssumedShape(sym) || + !Fortran::evaluate::IsAssumedShape(sym) || Fortran::evaluate::IsSimplyContiguous(sym, converter.getFoldingContext()) || // TARGET dummy may be accessed indirectly, so it is unsafe diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp index 83f59f0cac3df..70e79df42cb6e 100644 --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -600,7 +600,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, "Element of pointer array may not be associated with a %s array"_err_en_US, dummyName); } - } else if (IsAssumedShape(*actualLastSymbol) && + } else if (evaluate::IsAssumedShape(*actualLastSymbol) && !dummy.ignoreTKR.test(common::IgnoreTKR::Contiguous)) { if (isOkBecauseContiguous) { context.Warn( @@ -1390,7 +1390,7 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg, assumed.name(), dummyName); } else if (object.type.attrs().test(characteristics:: TypeAndShape::Attr::AssumedRank) && - !IsAssumedShape(assumed) && + !evaluate::IsAssumedShape(assumed) && !evaluate::IsAssumedRank(assumed)) { messages.Say( // C711 "Assumed-type '%s' must be either assumed shape or assumed rank to be associated with assumed rank %s"_err_en_US, diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index d769f221b1983..a72b850d2ba5f 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -1206,7 +1206,7 @@ void CheckHelper::CheckObjectEntity( if (derived && derived->IsVectorType()) { CHECK(type); std::string typeName{type->AsFortran()}; - if (IsAssumedShape(symbol)) { + if (evaluate::IsAssumedShape(symbol)) { SayWithDeclaration(symbol, "Assumed-shape entity of %s type is not supported"_err_en_US, typeName); @@ -2427,7 +2427,7 @@ void CheckHelper::CheckVolatile(const Symbol &symbol, void CheckHelper::CheckContiguous(const Symbol &symbol) { if (evaluate::IsVariable(symbol) && - ((IsPointer(symbol) && symbol.Rank() > 0) || IsAssumedShape(symbol) || + ((IsPointer(symbol) && symbol.Rank() > 0) || evaluate::IsAssumedShape(symbol) || evaluate::IsAssumedRank(symbol))) { } else { parser::MessageFixedText msg{symbol.owner().IsDerivedType() diff --git a/flang/lib/Semantics/check-omp-loop.cpp b/flang/lib/Semantics/check-omp-loop.cpp index 8dad1f5d605e7..166462da2fbb3 100644 --- a/flang/lib/Semantics/check-omp-loop.cpp +++ b/flang/lib/Semantics/check-omp-loop.cpp @@ -590,7 +590,7 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Linear &x) { if (linearMod->v != parser::OmpLinearModifier::Value::Ref) { CheckIntegerNoRef(symbol, source); } else { - if (!IsAllocatable(*symbol) && !IsAssumedShape(*symbol) && + if (!IsAllocatable(*symbol) && !evaluate::IsAssumedShape(*symbol) && !IsPolymorphic(*symbol)) { context_.Say(source, "The list item `%s` specified with the REF '%s' must be polymorphic variable, assumed-shape array, or a variable with the `ALLOCATABLE` attribute"_err_en_US, diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp index fe0d2a73805de..e2832121f98b6 100644 --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -2438,7 +2438,7 @@ static bool IsTargetCaptureImplicitlyFirstprivatizeable(const Symbol &symbol, // investigate the flags we can intermix with. if (!(dsa & (dataSharingAttributeFlags | dataMappingAttributeFlags)) .none() || - !checkSym.flags().none() || semantics::IsAssumedShape(checkSym) || + !checkSym.flags().none() || evaluate::IsAssumedShape(checkSym) || semantics::IsAllocatableOrPointer(checkSym)) { return false; } @@ -3164,7 +3164,7 @@ static bool IsSymbolPrivate(const Symbol &symbol) { case Scope::Kind::Subprogram: case Scope::Kind::BlockConstruct: return !symbol.attrs().test(Attr::SAVE) && - !symbol.attrs().test(Attr::PARAMETER) && !IsAssumedShape(symbol) && + !symbol.attrs().test(Attr::PARAMETER) && !evaluate::IsAssumedShape(symbol) && !symbol.flags().test(Symbol::Flag::InCommonBlock); default: return false; From 47f26560328e3f53127b72fd319522e07017271b Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Fri, 15 Aug 2025 17:38:21 -0400 Subject: [PATCH 35/79] clang-format --- flang/lib/Evaluate/call.cpp | 4 ++-- flang/lib/Evaluate/check-expression.cpp | 4 ++-- flang/lib/Semantics/check-declarations.cpp | 3 ++- flang/lib/Semantics/resolve-directives.cpp | 5 +++-- 4 files changed, 9 insertions(+), 7 deletions(-) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index 90356f6a34fcf..839fecab41380 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -351,8 +351,8 @@ static void DetermineCopyInOutArgument( bool actualIsAssumedShape{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. + // 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, diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index d8780c2ca5aa5..771f873de37e8 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1001,8 +1001,8 @@ class IsContiguousHelper } else { return Base::operator()(ultimate); // use expr } - } else if (semantics::IsPointer(ultimate) || - IsAssumedShape(ultimate) || IsAssumedRank(ultimate)) { + } else if (semantics::IsPointer(ultimate) || IsAssumedShape(ultimate) || + IsAssumedRank(ultimate)) { return std::nullopt; } else if (ultimate.has()) { return true; diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index a72b850d2ba5f..d44421f05f0a4 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -2427,7 +2427,8 @@ void CheckHelper::CheckVolatile(const Symbol &symbol, void CheckHelper::CheckContiguous(const Symbol &symbol) { if (evaluate::IsVariable(symbol) && - ((IsPointer(symbol) && symbol.Rank() > 0) || evaluate::IsAssumedShape(symbol) || + ((IsPointer(symbol) && symbol.Rank() > 0) || + evaluate::IsAssumedShape(symbol) || evaluate::IsAssumedRank(symbol))) { } else { parser::MessageFixedText msg{symbol.owner().IsDerivedType() diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp index e2832121f98b6..3ebf099205d39 100644 --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -2437,7 +2437,7 @@ static bool IsTargetCaptureImplicitlyFirstprivatizeable(const Symbol &symbol, // TODO: Relax restriction as we progress privitization and further // investigate the flags we can intermix with. if (!(dsa & (dataSharingAttributeFlags | dataMappingAttributeFlags)) - .none() || + .none() || !checkSym.flags().none() || evaluate::IsAssumedShape(checkSym) || semantics::IsAllocatableOrPointer(checkSym)) { return false; @@ -3164,7 +3164,8 @@ static bool IsSymbolPrivate(const Symbol &symbol) { case Scope::Kind::Subprogram: case Scope::Kind::BlockConstruct: return !symbol.attrs().test(Attr::SAVE) && - !symbol.attrs().test(Attr::PARAMETER) && !evaluate::IsAssumedShape(symbol) && + !symbol.attrs().test(Attr::PARAMETER) && + !evaluate::IsAssumedShape(symbol) && !symbol.flags().test(Symbol::Flag::InCommonBlock); default: return false; From aa65a3ef202870c9be1bb777ae532e55a26827c6 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Mon, 18 Aug 2025 09:44:43 -0400 Subject: [PATCH 36/79] Passes LIT tests --- flang/include/flang/Lower/CallInterface.h | 2 -- flang/lib/Lower/ConvertCall.cpp | 23 ++++++++++------------- flang/lib/Semantics/expression.cpp | 1 + 3 files changed, 11 insertions(+), 15 deletions(-) diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h index 6e3bdc0d9104c..72bc9dd890a94 100644 --- a/flang/include/flang/Lower/CallInterface.h +++ b/flang/include/flang/Lower/CallInterface.h @@ -159,8 +159,6 @@ class CallInterface { /// PassedEntity is what is provided back to the CallInterface user. /// It describe how the entity is plugged in the interface struct PassedEntity { - /// Helps with caller/callee differentiation - static constexpr bool isCaller = std::is_same_v; /// Is the dummy argument optional? bool isOptional() const; /// Can the argument be modified by the callee? diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index 1d92a634059ea..fbc3837f61dcb 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1204,6 +1204,10 @@ static bool isParameterObjectOrSubObject(hlfir::Entity entity) { /// fir.box_char...). /// This function should only be called with an actual that is present. /// The optional aspects must be handled by this function user. +/// +/// Note: while Fortran::lower::CallerInterface::PassedEntity (the type of arg) +/// is technically a template type, in the prepare*ActualArgument() calls +/// it resolves to Fortran::evaluate::ActualArgument * static PreparedDummyArgument preparePresentUserCallActualArgument( mlir::Location loc, fir::FirOpBuilder &builder, const Fortran::lower::PreparedActualArgument &preparedActual, @@ -1263,21 +1267,14 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( bool mustDoCopyOut = mustDoCopyIn && arg.mayBeModifiedByCall(); bool newMustDoCopyIn = false; bool newMustDoCopyOut = false; - if constexpr (Fortran::lower::CallerInterface::PassedEntity::isCaller) { - newMustDoCopyIn = arg.entity->GetMayNeedCopyIn(); - newMustDoCopyOut = arg.entity->GetMayNeedCopyOut(); + newMustDoCopyIn = actual.isArray() && arg.entity->GetMayNeedCopyIn(); + newMustDoCopyOut = newMustDoCopyIn && arg.entity->GetMayNeedCopyOut(); #if 1 - llvm::dbgs() << "copyinout: CALLER " << "copy-in: old=" << mustDoCopyIn - << ", new=" << newMustDoCopyIn - << "| copy-out: old=" << mustDoCopyOut - << ", new=" << newMustDoCopyOut << "\n"; + llvm::dbgs() << "copyinout: CALLER " << "copy-in: old=" << mustDoCopyIn + << ", new=" << newMustDoCopyIn + << "| copy-out: old=" << mustDoCopyOut + << ", new=" << newMustDoCopyOut << "\n"; #endif - } else { -#if 1 - llvm::dbgs() << "copyinout: CALLEE " << "copy-in=" << mustDoCopyIn - << ", copy-out=" << mustDoCopyOut << "\n"; -#endif - } mustDoCopyIn = newMustDoCopyIn; mustDoCopyOut = newMustDoCopyOut; diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index 56ae4099c5322..18ee83cf4da45 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -4389,6 +4389,7 @@ MaybeExpr ExpressionAnalyzer::MakeFunctionRef(parser::CharBlock callSite, if (chars->functionResult) { const auto &result{*chars->functionResult}; ProcedureRef procRef{std::move(proc), std::move(arguments)}; + procRef.DetermineCopyInOut(); if (result.IsProcedurePointer()) { return Expr{std::move(procRef)}; } else { From d285ded9079b4bebb2a30d5062efc8e4ad09500b Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Mon, 18 Aug 2025 10:10:03 -0400 Subject: [PATCH 37/79] Clean up in lowering to switch to the new checks --- flang/lib/Lower/ConvertCall.cpp | 36 ++------------------------------- 1 file changed, 2 insertions(+), 34 deletions(-) diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index fbc3837f61dcb..d12f51218b606 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1161,18 +1161,6 @@ mlir::Value static getZeroLowerBounds(mlir::Location loc, return builder.genShift(loc, lowerBounds); } -static bool -isSimplyContiguous(const Fortran::evaluate::ActualArgument &arg, - Fortran::evaluate::FoldingContext &foldingContext) { - if (const auto *expr = arg.UnwrapExpr()) - return Fortran::evaluate::IsSimplyContiguous(*expr, foldingContext); - const Fortran::semantics::Symbol *sym = arg.GetAssumedTypeDummy(); - assert(sym && - "expect ActualArguments to be expression or assumed-type symbols"); - return sym->Rank() == 0 || - Fortran::evaluate::IsSimplyContiguous(*sym, foldingContext); -} - static bool isParameterObjectOrSubObject(hlfir::Entity entity) { mlir::Value base = entity; bool foundParameter = false; @@ -1215,9 +1203,6 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( const Fortran::lower::CallerInterface::PassedEntity &arg, CallContext &callContext) { - Fortran::evaluate::FoldingContext &foldingContext = - callContext.converter.getFoldingContext(); - // Step 1: get the actual argument, which includes addressing the // element if this is an array in an elemental call. hlfir::Entity actual = preparedActual.getActual(loc, builder); @@ -1258,25 +1243,8 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( passingPolymorphicToNonPolymorphic && (actual.isArray() || mlir::isa(dummyType)); - // The simple contiguity of the actual is "lost" when passing a polymorphic - // to a non polymorphic entity because the dummy dynamic type matters for - // the contiguity. - bool mustDoCopyIn = actual.isArray() && arg.mustBeMadeContiguous() && - (passingPolymorphicToNonPolymorphic || - !isSimplyContiguous(*arg.entity, foldingContext)); - bool mustDoCopyOut = mustDoCopyIn && arg.mayBeModifiedByCall(); - bool newMustDoCopyIn = false; - bool newMustDoCopyOut = false; - newMustDoCopyIn = actual.isArray() && arg.entity->GetMayNeedCopyIn(); - newMustDoCopyOut = newMustDoCopyIn && arg.entity->GetMayNeedCopyOut(); -#if 1 - llvm::dbgs() << "copyinout: CALLER " << "copy-in: old=" << mustDoCopyIn - << ", new=" << newMustDoCopyIn - << "| copy-out: old=" << mustDoCopyOut - << ", new=" << newMustDoCopyOut << "\n"; -#endif - mustDoCopyIn = newMustDoCopyIn; - mustDoCopyOut = newMustDoCopyOut; + bool mustDoCopyIn = actual.isArray() && arg.entity->GetMayNeedCopyIn(); + bool mustDoCopyOut = mustDoCopyIn && arg.entity->GetMayNeedCopyOut(); const bool actualIsAssumedRank = actual.isAssumedRank(); // Create dummy type with actual argument rank when the dummy is an assumed From 413eafd25752fa4e0e440c56c55d30a9fff1dea5 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Mon, 18 Aug 2025 11:33:52 -0400 Subject: [PATCH 38/79] Ignore rank support --- flang/lib/Evaluate/call.cpp | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index 839fecab41380..a6031e2fa206a 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -307,7 +307,9 @@ static void DetermineCopyInOutArgument( bool dummyIsAssumedRank{dummyObj->type.attrs().test( characteristics::TypeAndShape::Attr::AssumedRank)}; bool dummyIsArray{dummyIsAssumedRank || dummyObj->type.Rank() > 0}; - if (!actualIsArray || !dummyIsArray) { + bool treatDummyScalarAsArray{dummyObj->type.Rank() == 0 && + dummyObj->ignoreTKR.test(common::IgnoreTKR::Rank)}; + if (!actualIsArray || !(dummyIsArray || treatDummyScalarAsArray)) { return; } @@ -335,6 +337,7 @@ static void DetermineCopyInOutArgument( bool dummyIsAssumedSize{dummyObj->type.attrs().test( characteristics::TypeAndShape::Attr::AssumedSize)}; bool dummyNeedsContiguity{dummyIsExplicitShape || dummyIsAssumedSize || + treatDummyScalarAsArray || dummyObj->attrs.test(characteristics::DummyDataObject::Attr::Contiguous)}; if (!actualTreatAsContiguous && dummyNeedsContiguity) { setCopyIn(); From 4590955c478d30a739b0b66d4f63a13f1de3b1be Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Mon, 18 Aug 2025 12:20:16 -0400 Subject: [PATCH 39/79] Polymorphic dummy with ignore rank --- flang/lib/Evaluate/call.cpp | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index a6031e2fa206a..51ce3a04166ac 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -336,8 +336,12 @@ static void DetermineCopyInOutArgument( bool dummyIsExplicitShape{dummyObj->type.IsExplicitShape()}; bool dummyIsAssumedSize{dummyObj->type.attrs().test( characteristics::TypeAndShape::Attr::AssumedSize)}; + bool dummyIsPolymorphic{dummyObj->type.type().IsPolymorphic()}; + // Explicit shape and assumed size arrays must be contiguous bool dummyNeedsContiguity{dummyIsExplicitShape || dummyIsAssumedSize || - treatDummyScalarAsArray || + // Polymorphic dummy is descriptor based, so should be able to handle + // discontigunity. + (treatDummyScalarAsArray && !dummyIsPolymorphic) || dummyObj->attrs.test(characteristics::DummyDataObject::Attr::Contiguous)}; if (!actualTreatAsContiguous && dummyNeedsContiguity) { setCopyIn(); @@ -364,7 +368,6 @@ static void DetermineCopyInOutArgument( auto actualType{characteristics::TypeAndShape::Characterize( actual, sc.foldingContext())}; bool actualIsPolymorphic{actualType->type().IsPolymorphic()}; - bool dummyIsPolymorphic{dummyObj->type.type().IsPolymorphic()}; if (actualIsPolymorphic && !dummyIsPolymorphic) { setCopyIn(); setCopyOut(); From d026e0dfe0a80c372a03cc5992c993eeaf2ac571 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Mon, 18 Aug 2025 12:28:39 -0400 Subject: [PATCH 40/79] clang-format (upstream) --- flang/lib/Evaluate/call.cpp | 4 ++-- flang/lib/Semantics/resolve-directives.cpp | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index 51ce3a04166ac..353f17b57f15d 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -260,8 +260,8 @@ static void DetermineCopyInOutArgument( // Actual argument expressions that aren’t variables are copy-in, but // not copy-out. actual.SetMayNeedCopyIn(); - } else if (bool actualIsArray{actual.Rank() > 0}; actualIsArray && - !IsSimplyContiguous(actual, sc.foldingContext())) { + } else if (bool actualIsArray{actual.Rank() > 0}; + actualIsArray &&!IsSimplyContiguous(actual, sc.foldingContext())) { // Actual arguments that are variables are copy-in when non-contiguous. // They are copy-out when don't have vector subscripts actual.SetMayNeedCopyIn(); diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp index 3ebf099205d39..5a244e5183e39 100644 --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -2437,7 +2437,7 @@ static bool IsTargetCaptureImplicitlyFirstprivatizeable(const Symbol &symbol, // TODO: Relax restriction as we progress privitization and further // investigate the flags we can intermix with. if (!(dsa & (dataSharingAttributeFlags | dataMappingAttributeFlags)) - .none() || + .none() || !checkSym.flags().none() || evaluate::IsAssumedShape(checkSym) || semantics::IsAllocatableOrPointer(checkSym)) { return false; From 0289de2ca7f6e90efa73416e969084f9c520d6e6 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Mon, 18 Aug 2025 12:55:50 -0400 Subject: [PATCH 41/79] clang-format (upstream) --- flang/lib/Evaluate/call.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index 353f17b57f15d..bdf9561d9582b 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -261,7 +261,7 @@ static void DetermineCopyInOutArgument( // not copy-out. actual.SetMayNeedCopyIn(); } else if (bool actualIsArray{actual.Rank() > 0}; - actualIsArray &&!IsSimplyContiguous(actual, sc.foldingContext())) { + actualIsArray &&!IsSimplyContiguous(actual, sc.foldingContext())) { // Actual arguments that are variables are copy-in when non-contiguous. // They are copy-out when don't have vector subscripts actual.SetMayNeedCopyIn(); From 2464dd3e5b376e25f78cbc862b3f27d6b779cf3d Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Mon, 18 Aug 2025 12:58:40 -0400 Subject: [PATCH 42/79] clang-format (started using upstream) --- flang/lib/Evaluate/call.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index bdf9561d9582b..03fdc9b147841 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -261,7 +261,7 @@ static void DetermineCopyInOutArgument( // not copy-out. actual.SetMayNeedCopyIn(); } else if (bool actualIsArray{actual.Rank() > 0}; - actualIsArray &&!IsSimplyContiguous(actual, sc.foldingContext())) { + actualIsArray && !IsSimplyContiguous(actual, sc.foldingContext())) { // Actual arguments that are variables are copy-in when non-contiguous. // They are copy-out when don't have vector subscripts actual.SetMayNeedCopyIn(); From f76c9e33240e7dcd91b92d2d7d8c98d7431a37c6 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Mon, 18 Aug 2025 13:39:48 -0400 Subject: [PATCH 43/79] Added LIT test --- flang/test/Lower/force-temp.f90 | 35 +++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) create mode 100644 flang/test/Lower/force-temp.f90 diff --git a/flang/test/Lower/force-temp.f90 b/flang/test/Lower/force-temp.f90 new file mode 100644 index 0000000000000..1cfa218cfe7ab --- /dev/null +++ b/flang/test/Lower/force-temp.f90 @@ -0,0 +1,35 @@ +! RUN: bbc -emit-hlfir -o - %s | FileCheck %s +! Ensure that copy-in/copy-out happens with specific ignore_tkr settings +module test + interface + subroutine pass_ignore_tkr(buf) + implicit none + !DIR$ IGNORE_TKR buf + real :: buf + end subroutine + subroutine pass_ignore_tkr_c(buf) + implicit none + !DIR$ IGNORE_TKR (tkrc) buf + real :: buf + end subroutine + end interface +contains + subroutine s1(buf) +!CHECK-LABEL: func.func @_QMtestPs1 +!CHECK: hlfir.copy_in +!CHECK: fir.call @_QPpass_ignore_tkr +!CHECK: hlfir.copy_out + real, intent(inout) :: buf(:) + ! Create temp here + call pass_ignore_tkr(buf) + end subroutine + subroutine s2(buf) +!CHECK-LABEL: func.func @_QMtestPs2 +!CHECK-NOT: hlfir.copy_in +!CHECK: fir.call @_QPpass_ignore_tkr_c +!CHECK-NOT: hlfir.copy_out + real, intent(inout) :: buf(:) + ! Don't create temp here + call pass_ignore_tkr_c(buf) + end subroutine +end module From b12d2c82f35c0f2aa7ff9713c2c3aa866d73768b Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Mon, 18 Aug 2025 15:56:28 -0400 Subject: [PATCH 44/79] Implement copy-in/copy-out determination in Fortran::evaluate::MayNeedCopyInOut() --- .../include/flang/Evaluate/check-expression.h | 22 +++ flang/lib/Evaluate/check-expression.cpp | 129 ++++++++++++++++++ flang/lib/Lower/ConvertCall.cpp | 8 +- 3 files changed, 157 insertions(+), 2 deletions(-) diff --git a/flang/include/flang/Evaluate/check-expression.h b/flang/include/flang/Evaluate/check-expression.h index 7059e03b408c1..ff5b01edfce07 100644 --- a/flang/include/flang/Evaluate/check-expression.h +++ b/flang/include/flang/Evaluate/check-expression.h @@ -163,5 +163,27 @@ extern template bool IsErrorExpr(const Expr &); std::optional CheckStatementFunction( const Symbol &, const Expr &, FoldingContext &); +// Returns a pair of Booleans. The first boolean specifies whether given actual +// argument may need copy-in operation and the second Boolean specifies whether +// copy-out may be necessary. This function works with implicit interface +// procedures. +std::pair MayNeedCopyInOut(const ActualArgument &, + FoldingContext &); + +// Returns a pair of Booleans. The first boolean specifies whether given actual +// and dummy argument pair may need copy-in operation for the actual argument, +// and the second Boolean specifies whether copy-out may be necessary. +// This function works with explicit interface procedures. +std::pair MayNeedCopyInOut(const ActualArgument &, + const characteristics::DummyArgument &, FoldingContext &); + +inline std::pair MayNeedCopyInOut(const ActualArgument &actual, + const characteristics::DummyArgument *dummy, FoldingContext &fc) { + if (dummy) + return MayNeedCopyInOut(actual, *dummy, fc); + else + return MayNeedCopyInOut(actual, fc); +} + } // namespace Fortran::evaluate #endif diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index 771f873de37e8..dd174a564f0c9 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1446,4 +1446,133 @@ std::optional CheckStatementFunction( return StmtFunctionChecker{sf, context}(expr); } +std::pair MayNeedCopyInOut(const ActualArgument &actual, + FoldingContext &fc) { + bool mayNeedCopyIn{false}; + bool mayNeedCopyOut{false}; + if (actual.isAlternateReturn()) { + return {mayNeedCopyIn, mayNeedCopyOut}; + } + if (!evaluate::IsVariable(actual)) { + // Actual argument expressions that aren’t variables are copy-in, but + // not copy-out. + mayNeedCopyIn = true; + } else if (bool actualIsArray{actual.Rank() > 0}; + actualIsArray && !IsSimplyContiguous(actual, fc)) { + // Actual arguments that are variables are copy-in when non-contiguous. + // They are copy-out when don't have vector subscripts + mayNeedCopyIn = true; + if (!HasVectorSubscript(actual)) { + mayNeedCopyOut = true; + } + } else if (ExtractCoarrayRef(actual)) { + // Coindexed actual args need copy-in and copy-out + mayNeedCopyIn = true; + mayNeedCopyOut = true; + } + + return {mayNeedCopyIn, mayNeedCopyOut}; +} + +std::pair MayNeedCopyInOut(const ActualArgument &actual, + const characteristics::DummyArgument &dummy, FoldingContext &fc) { + bool mayNeedCopyIn{false}; + bool mayNeedCopyOut{false}; + if (actual.isAlternateReturn()) { + return {mayNeedCopyIn, mayNeedCopyOut}; + } + if (!evaluate::IsVariable(actual)) { + // Actual argument expressions that aren’t variables are copy-in, but + // not copy-out. + mayNeedCopyIn = true; + return {mayNeedCopyIn, mayNeedCopyOut}; + } + const auto *dummyObj{std::get_if(&dummy.u)}; + if (!dummyObj) { + // Only DummyDataObject has the information we need + return {mayNeedCopyIn, mayNeedCopyOut}; + } + // Pass by value, always copy-in, never copy-out + bool dummyIsValue{ + dummyObj->attrs.test(characteristics::DummyDataObject::Attr::Value)}; + if (dummyIsValue) { + mayNeedCopyIn = true; + return {mayNeedCopyIn, mayNeedCopyOut}; + } + // All the checks below are for arrays + + bool actualIsAssumedRank{evaluate::IsAssumedRank(actual)}; + bool actualIsArray{actualIsAssumedRank || actual.Rank() > 0}; + bool dummyIsAssumedRank{dummyObj->type.attrs().test( + characteristics::TypeAndShape::Attr::AssumedRank)}; + bool dummyIsArray{dummyIsAssumedRank || dummyObj->type.Rank() > 0}; + bool treatDummyScalarAsArray{dummyObj->type.Rank() == 0 && + dummyObj->ignoreTKR.test(common::IgnoreTKR::Rank)}; + if (!actualIsArray || !(dummyIsArray || treatDummyScalarAsArray)) { + return {mayNeedCopyIn, mayNeedCopyOut}; + } + + bool dummyIntentIn{dummyObj->intent == common::Intent::In}; + bool dummyIntentOut{dummyObj->intent == common::Intent::Out}; + auto setCopyIn = [&]() { + if (!dummyIntentOut) { + // INTENT(OUT) dummy args never need copy-in + mayNeedCopyIn = true; + } + }; + auto setCopyOut = [&]() { + if (!dummyIntentIn) { + // INTENT(IN) dummy args never need copy-out + mayNeedCopyOut = true; + } + }; + + // Check actual contiguity, unless dummy doesn't care + bool actualTreatAsContiguous{ + dummyObj->ignoreTKR.test(common::IgnoreTKR::Contiguous) || + IsSimplyContiguous(actual, fc)}; + bool actualHasVectorSubscript{HasVectorSubscript(actual)}; + bool dummyIsExplicitShape{dummyObj->type.IsExplicitShape()}; + bool dummyIsAssumedSize{dummyObj->type.attrs().test( + characteristics::TypeAndShape::Attr::AssumedSize)}; + bool dummyIsPolymorphic{dummyObj->type.type().IsPolymorphic()}; + // Explicit shape and assumed size arrays must be contiguous + bool dummyNeedsContiguity{dummyIsExplicitShape || dummyIsAssumedSize || + // Polymorphic dummy is descriptor based, so should be able to handle + // discontigunity. + (treatDummyScalarAsArray && !dummyIsPolymorphic) || + dummyObj->attrs.test(characteristics::DummyDataObject::Attr::Contiguous)}; + if (!actualTreatAsContiguous && dummyNeedsContiguity) { + setCopyIn(); + // Cannot do copy-out for vector subscripts: there could be repeated + // indices, for example + if (!actualHasVectorSubscript) { + setCopyOut(); + } + return {mayNeedCopyIn, mayNeedCopyOut}; + } + + bool dummyIsAssumedShape{dummyObj->type.attrs().test( + characteristics::TypeAndShape::Attr::AssumedShape)}; + bool actualIsAssumedShape{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.) + auto actualType{characteristics::TypeAndShape::Characterize(actual, fc)}; + bool actualIsPolymorphic{actualType->type().IsPolymorphic()}; + if (actualIsPolymorphic && !dummyIsPolymorphic) { + setCopyIn(); + setCopyOut(); + } + } + + return {mayNeedCopyIn, mayNeedCopyOut}; +} + } // namespace Fortran::evaluate diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index d12f51218b606..d7a5efdb00cfb 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1243,8 +1243,12 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( passingPolymorphicToNonPolymorphic && (actual.isArray() || mlir::isa(dummyType)); - bool mustDoCopyIn = actual.isArray() && arg.entity->GetMayNeedCopyIn(); - bool mustDoCopyOut = mustDoCopyIn && arg.entity->GetMayNeedCopyOut(); + Fortran::evaluate::FoldingContext &foldingContext{ + callContext.converter.getFoldingContext()}; + auto [suggestCopyIn, suggestCopyOut] = Fortran::evaluate::MayNeedCopyInOut( + *arg.entity, arg.characteristics, foldingContext); + bool mustDoCopyIn = actual.isArray() && suggestCopyIn; + bool mustDoCopyOut = mustDoCopyIn && suggestCopyOut; const bool actualIsAssumedRank = actual.isAssumedRank(); // Create dummy type with actual argument rank when the dummy is an assumed From 24c2040b84bb652c3638ee9b7aeec5c7ddba37fc Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Mon, 18 Aug 2025 16:09:18 -0400 Subject: [PATCH 45/79] clang-format --- flang/include/flang/Evaluate/check-expression.h | 4 ++-- flang/lib/Evaluate/check-expression.cpp | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/flang/include/flang/Evaluate/check-expression.h b/flang/include/flang/Evaluate/check-expression.h index ff5b01edfce07..0499f353025b5 100644 --- a/flang/include/flang/Evaluate/check-expression.h +++ b/flang/include/flang/Evaluate/check-expression.h @@ -167,8 +167,8 @@ std::optional CheckStatementFunction( // argument may need copy-in operation and the second Boolean specifies whether // copy-out may be necessary. This function works with implicit interface // procedures. -std::pair MayNeedCopyInOut(const ActualArgument &, - FoldingContext &); +std::pair MayNeedCopyInOut( + const ActualArgument &, FoldingContext &); // Returns a pair of Booleans. The first boolean specifies whether given actual // and dummy argument pair may need copy-in operation for the actual argument, diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index dd174a564f0c9..d34c1381e6b28 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1446,8 +1446,8 @@ std::optional CheckStatementFunction( return StmtFunctionChecker{sf, context}(expr); } -std::pair MayNeedCopyInOut(const ActualArgument &actual, - FoldingContext &fc) { +std::pair MayNeedCopyInOut( + const ActualArgument &actual, FoldingContext &fc) { bool mayNeedCopyIn{false}; bool mayNeedCopyOut{false}; if (actual.isAlternateReturn()) { From a760320db1ea3d02768978c0ecbb58b3a5af060a Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Mon, 18 Aug 2025 19:02:42 -0400 Subject: [PATCH 46/79] Removed the old way to integrate copy-in/copy-out check --- flang/include/flang/Evaluate/call.h | 19 +-- flang/lib/Evaluate/call.cpp | 196 ---------------------------- flang/lib/Semantics/expression.cpp | 2 - 3 files changed, 2 insertions(+), 215 deletions(-) diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h index efdcee709d435..2a5929b873d74 100644 --- a/flang/include/flang/Evaluate/call.h +++ b/flang/include/flang/Evaluate/call.h @@ -52,7 +52,7 @@ using SymbolRef = common::Reference; class ActualArgument { public: - ENUM_CLASS(Attr, PassedObject, PercentVal, PercentRef, CopyIn, CopyOut); + ENUM_CLASS(Attr, PassedObject, PercentVal, PercentRef); using Attrs = common::EnumSet; // Dummy arguments that are TYPE(*) can be forwarded as actual arguments. @@ -131,6 +131,7 @@ class ActualArgument { return *this; } + bool Matches(const characteristics::DummyArgument &) const; common::Intent dummyIntent() const { return dummyIntent_; } ActualArgument &set_dummyIntent(common::Intent intent) { dummyIntent_ = intent; @@ -160,20 +161,6 @@ class ActualArgument { return *this; } - // This actual argument may need copy-in before the procedure call - bool GetMayNeedCopyIn() const { return attrs_.test(Attr::CopyIn); }; - ActualArgument &SetMayNeedCopyIn() { - attrs_ = attrs_ + Attr::CopyIn; - return *this; - } - - // This actual argument may need copy-out after the procedure call - bool GetMayNeedCopyOut() const { return attrs_.test(Attr::CopyOut); }; - ActualArgument &SetMayNeedCopyOut() { - attrs_ = attrs_ + Attr::CopyOut; - return *this; - } - private: // Subtlety: There is a distinction that must be maintained here between an // actual argument expression that is a variable and one that is not, @@ -285,8 +272,6 @@ class ProcedureRef { bool operator==(const ProcedureRef &) const; llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const; - void DetermineCopyInOut(); - protected: ProcedureDesignator proc_; ActualArguments arguments_; diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index 03fdc9b147841..f77df92a7597a 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -12,7 +12,6 @@ #include "flang/Evaluate/check-expression.h" #include "flang/Evaluate/expression.h" #include "flang/Evaluate/tools.h" -#include "flang/Semantics/semantics.h" #include "flang/Semantics/symbol.h" #include "flang/Support/Fortran.h" @@ -248,199 +247,4 @@ ProcedureRef::~ProcedureRef() {} void ProcedureRef::Deleter(ProcedureRef *p) { delete p; } -// We don't know the dummy argument info (e.g., procedure with implicit -// interface -static void DetermineCopyInOutArgument( - const characteristics::Procedure &procInfo, ActualArgument &actual, - semantics::SemanticsContext &sc) { - if (actual.isAlternateReturn()) { - return; - } - if (!evaluate::IsVariable(actual)) { - // Actual argument expressions that aren’t variables are copy-in, but - // not copy-out. - actual.SetMayNeedCopyIn(); - } else if (bool actualIsArray{actual.Rank() > 0}; - actualIsArray && !IsSimplyContiguous(actual, sc.foldingContext())) { - // Actual arguments that are variables are copy-in when non-contiguous. - // They are copy-out when don't have vector subscripts - actual.SetMayNeedCopyIn(); - if (!HasVectorSubscript(actual)) { - actual.SetMayNeedCopyOut(); - } - } else if (ExtractCoarrayRef(actual)) { - // Coindexed actual args need copy-in and copy-out - actual.SetMayNeedCopyIn(); - actual.SetMayNeedCopyOut(); - } -} - -static void DetermineCopyInOutArgument( - const characteristics::Procedure &procInfo, ActualArgument &actual, - characteristics::DummyArgument &dummy, semantics::SemanticsContext &sc) { - assert(procInfo.HasExplicitInterface() && "expect explicit interface proc"); - if (actual.isAlternateReturn()) { - return; - } - if (!evaluate::IsVariable(actual)) { - // Actual argument expressions that aren’t variables are copy-in, but - // not copy-out. - actual.SetMayNeedCopyIn(); - return; - } - const auto *dummyObj{std::get_if(&dummy.u)}; - if (!dummyObj) { - // Only DummyDataObject has the information we need - return; - } - // Pass by value, always copy-in, never copy-out - bool dummyIsValue{ - dummyObj->attrs.test(characteristics::DummyDataObject::Attr::Value)}; - if (dummyIsValue) { - actual.SetMayNeedCopyIn(); - return; - } - // All the checks below are for arrays - - bool actualIsAssumedRank{evaluate::IsAssumedRank(actual)}; - bool actualIsArray{actualIsAssumedRank || actual.Rank() > 0}; - bool dummyIsAssumedRank{dummyObj->type.attrs().test( - characteristics::TypeAndShape::Attr::AssumedRank)}; - bool dummyIsArray{dummyIsAssumedRank || dummyObj->type.Rank() > 0}; - bool treatDummyScalarAsArray{dummyObj->type.Rank() == 0 && - dummyObj->ignoreTKR.test(common::IgnoreTKR::Rank)}; - if (!actualIsArray || !(dummyIsArray || treatDummyScalarAsArray)) { - return; - } - - bool dummyIntentIn{dummyObj->intent == common::Intent::In}; - bool dummyIntentOut{dummyObj->intent == common::Intent::Out}; - auto setCopyIn = [&]() { - if (!dummyIntentOut) { - // INTENT(OUT) dummy args never need copy-in - actual.SetMayNeedCopyIn(); - } - }; - auto setCopyOut = [&]() { - if (!dummyIntentIn) { - // INTENT(IN) dummy args never need copy-out - actual.SetMayNeedCopyOut(); - } - }; - - // Check actual contiguity, unless dummy doesn't care - bool actualTreatAsContiguous{ - dummyObj->ignoreTKR.test(common::IgnoreTKR::Contiguous) || - IsSimplyContiguous(actual, sc.foldingContext())}; - bool actualHasVectorSubscript{HasVectorSubscript(actual)}; - bool dummyIsExplicitShape{dummyObj->type.IsExplicitShape()}; - bool dummyIsAssumedSize{dummyObj->type.attrs().test( - characteristics::TypeAndShape::Attr::AssumedSize)}; - bool dummyIsPolymorphic{dummyObj->type.type().IsPolymorphic()}; - // Explicit shape and assumed size arrays must be contiguous - bool dummyNeedsContiguity{dummyIsExplicitShape || dummyIsAssumedSize || - // Polymorphic dummy is descriptor based, so should be able to handle - // discontigunity. - (treatDummyScalarAsArray && !dummyIsPolymorphic) || - dummyObj->attrs.test(characteristics::DummyDataObject::Attr::Contiguous)}; - if (!actualTreatAsContiguous && dummyNeedsContiguity) { - setCopyIn(); - // Cannot do copy-out for vector subscripts: there could be repeated - // indices, for example - if (!actualHasVectorSubscript) { - setCopyOut(); - } - return; - } - - bool dummyIsAssumedShape{dummyObj->type.attrs().test( - characteristics::TypeAndShape::Attr::AssumedShape)}; - bool actualIsAssumedShape{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.) - auto actualType{characteristics::TypeAndShape::Characterize( - actual, sc.foldingContext())}; - bool actualIsPolymorphic{actualType->type().IsPolymorphic()}; - if (actualIsPolymorphic && !dummyIsPolymorphic) { - setCopyIn(); - setCopyOut(); - } - } -} - -void ProcedureRef::DetermineCopyInOut() { - if (!proc_.GetSymbol()) { - return; - } - // Get folding context of the call site owner - semantics::SemanticsContext &sc{proc_.GetSymbol()->owner().context()}; - FoldingContext &fc{sc.foldingContext()}; - auto procInfo{ - characteristics::Procedure::Characterize(proc_, fc, /*emitError=*/true)}; - if (!procInfo) { - return; - } - if (!procInfo->HasExplicitInterface()) { - for (auto &actual : arguments_) { - if (!actual) { - continue; - } - DetermineCopyInOutArgument(*procInfo, *actual, sc); - } - return; - } - // Don't change anything about actual or dummy arguments, except for - // computing copy-in/copy-out information. If detect something wrong with - // the arguments, stop processing and let semantic analysis generate the - // error messages. - size_t index{0}; - std::set processedKeywords; - bool seenKeyword{false}; - for (auto &actual : arguments_) { - if (!actual) { - continue; - } - if (index >= procInfo->dummyArguments.size()) { - // More actual arguments than dummy arguments. Semantic analysis will - // deal with the error. - return; - } - if (actual->keyword()) { - seenKeyword = true; - auto actualName{actual->keyword()->ToString()}; - if (processedKeywords.find(actualName) != processedKeywords.end()) { - // Actual arguments with duplicate keywords. Semantic analysis will - // deal with the error. - return; - } else { - processedKeywords.insert(actualName); - if (auto it{std::find_if(procInfo->dummyArguments.begin(), - procInfo->dummyArguments.end(), - [&](const characteristics::DummyArgument &dummy) { - return dummy.name == actualName; - })}; - it != procInfo->dummyArguments.end()) { - DetermineCopyInOutArgument(*procInfo, *actual, *it, sc); - } - } - } else if (seenKeyword) { - // Non-keyword actual argument after have seen at least one keyword - // actual argument. Semantic analysis will deal with the error. - return; - } else { - // Positional argument processing - DetermineCopyInOutArgument( - *procInfo, *actual, procInfo->dummyArguments[index], sc); - } - ++index; - } -} - } // namespace Fortran::evaluate diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index 18ee83cf4da45..d022378ce1455 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -3464,7 +3464,6 @@ void ExpressionAnalyzer::Analyze(const parser::CallStmt &callStmt) { HasAlternateReturns(callee->arguments)}, ProcedureRef::Deleter); DEREF(callStmt.typedCall.get()).set_chevrons(std::move(*chevrons)); - DEREF(callStmt.typedCall.get()).DetermineCopyInOut(); return; } } @@ -4389,7 +4388,6 @@ MaybeExpr ExpressionAnalyzer::MakeFunctionRef(parser::CharBlock callSite, if (chars->functionResult) { const auto &result{*chars->functionResult}; ProcedureRef procRef{std::move(proc), std::move(arguments)}; - procRef.DetermineCopyInOut(); if (result.IsProcedurePointer()) { return Expr{std::move(procRef)}; } else { From 7aa458cd975950a2e80787d2ef3d8d6fe09e6564 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Tue, 19 Aug 2025 11:42:13 -0400 Subject: [PATCH 47/79] Fixed the issue with user defined assignment --- flang/lib/Lower/ConvertCall.cpp | 28 +++++++++++++++++++--------- 1 file changed, 19 insertions(+), 9 deletions(-) diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index d7a5efdb00cfb..0c0083b2e0033 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -880,9 +880,10 @@ struct CallContext { std::optional resultType, mlir::Location loc, Fortran::lower::AbstractConverter &converter, Fortran::lower::SymMap &symMap, - Fortran::lower::StatementContext &stmtCtx) + Fortran::lower::StatementContext &stmtCtx, + bool doCopyIn = true) : procRef{procRef}, converter{converter}, symMap{symMap}, - stmtCtx{stmtCtx}, resultType{resultType}, loc{loc} {} + stmtCtx{stmtCtx}, resultType{resultType}, loc{loc}, doCopyIn{doCopyIn} {} fir::FirOpBuilder &getBuilder() { return converter.getFirOpBuilder(); } @@ -924,6 +925,7 @@ struct CallContext { Fortran::lower::StatementContext &stmtCtx; std::optional resultType; mlir::Location loc; + bool doCopyIn; }; using ExvAndCleanup = @@ -1243,12 +1245,17 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( passingPolymorphicToNonPolymorphic && (actual.isArray() || mlir::isa(dummyType)); - Fortran::evaluate::FoldingContext &foldingContext{ - callContext.converter.getFoldingContext()}; - auto [suggestCopyIn, suggestCopyOut] = Fortran::evaluate::MayNeedCopyInOut( - *arg.entity, arg.characteristics, foldingContext); - bool mustDoCopyIn = actual.isArray() && suggestCopyIn; - bool mustDoCopyOut = mustDoCopyIn && suggestCopyOut; + bool mustDoCopyIn{false}; + bool mustDoCopyOut{false}; + + if (callContext.doCopyIn) { + Fortran::evaluate::FoldingContext &foldingContext{ + callContext.converter.getFoldingContext()}; + auto [suggestCopyIn, suggestCopyOut] = Fortran::evaluate::MayNeedCopyInOut( + *arg.entity, arg.characteristics, foldingContext); + mustDoCopyIn = actual.isArray() && suggestCopyIn; + mustDoCopyOut = mustDoCopyIn && suggestCopyOut; + } const bool actualIsAssumedRank = actual.isAssumedRank(); // Create dummy type with actual argument rank when the dummy is an assumed @@ -2954,8 +2961,11 @@ void Fortran::lower::convertUserDefinedAssignmentToHLFIR( const evaluate::ProcedureRef &procRef, hlfir::Entity lhs, hlfir::Entity rhs, Fortran::lower::SymMap &symMap) { Fortran::lower::StatementContext definedAssignmentContext; + // For defined assignment, don't use regular copy-in/copy-out mechanism: + // defined assignment generates hlfir.region_assign construct, and this + // construct automatically handles any copy-in. CallContext callContext(procRef, /*resultType=*/std::nullopt, loc, converter, - symMap, definedAssignmentContext); + symMap, definedAssignmentContext, /*doCopyIn=*/false); Fortran::lower::CallerInterface caller(procRef, converter); mlir::FunctionType callSiteType = caller.genFunctionType(); PreparedActualArgument preparedLhs{lhs, /*isPresent=*/std::nullopt}; From d1a8d7c6a7eeb799fd82f8604f3ff6715998f908 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Tue, 19 Aug 2025 11:42:38 -0400 Subject: [PATCH 48/79] clang-format --- flang/lib/Lower/ConvertCall.cpp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index 0c0083b2e0033..824fe0b3e8db0 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -880,10 +880,10 @@ struct CallContext { std::optional resultType, mlir::Location loc, Fortran::lower::AbstractConverter &converter, Fortran::lower::SymMap &symMap, - Fortran::lower::StatementContext &stmtCtx, - bool doCopyIn = true) + Fortran::lower::StatementContext &stmtCtx, bool doCopyIn = true) : procRef{procRef}, converter{converter}, symMap{symMap}, - stmtCtx{stmtCtx}, resultType{resultType}, loc{loc}, doCopyIn{doCopyIn} {} + stmtCtx{stmtCtx}, resultType{resultType}, loc{loc}, doCopyIn{doCopyIn} { + } fir::FirOpBuilder &getBuilder() { return converter.getFirOpBuilder(); } From 57fd73e254f5c2776f4a3228e1cd992d6ec325a1 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Tue, 19 Aug 2025 12:14:26 -0400 Subject: [PATCH 49/79] Tweaked MayNeedCopyInOut() API --- flang/include/flang/Evaluate/check-expression.h | 14 +++++++++----- flang/lib/Lower/ConvertCall.cpp | 2 +- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/flang/include/flang/Evaluate/check-expression.h b/flang/include/flang/Evaluate/check-expression.h index 0499f353025b5..ac1e1549a99fb 100644 --- a/flang/include/flang/Evaluate/check-expression.h +++ b/flang/include/flang/Evaluate/check-expression.h @@ -177,12 +177,16 @@ std::pair MayNeedCopyInOut( std::pair MayNeedCopyInOut(const ActualArgument &, const characteristics::DummyArgument &, FoldingContext &); -inline std::pair MayNeedCopyInOut(const ActualArgument &actual, +inline std::pair MayNeedCopyInOut(const ActualArgument *actual, const characteristics::DummyArgument *dummy, FoldingContext &fc) { - if (dummy) - return MayNeedCopyInOut(actual, *dummy, fc); - else - return MayNeedCopyInOut(actual, fc); + if (!actual) { + return {false, false}; + } + if (dummy) { + return MayNeedCopyInOut(*actual, *dummy, fc); + } else { + return MayNeedCopyInOut(*actual, fc); + } } } // namespace Fortran::evaluate diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index 824fe0b3e8db0..dd97bb4d96978 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1252,7 +1252,7 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( Fortran::evaluate::FoldingContext &foldingContext{ callContext.converter.getFoldingContext()}; auto [suggestCopyIn, suggestCopyOut] = Fortran::evaluate::MayNeedCopyInOut( - *arg.entity, arg.characteristics, foldingContext); + arg.entity, arg.characteristics, foldingContext); mustDoCopyIn = actual.isArray() && suggestCopyIn; mustDoCopyOut = mustDoCopyIn && suggestCopyOut; } From b7dab28c4eeb12dbe5c075df4c6994eac13f96c4 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Tue, 19 Aug 2025 13:19:17 -0400 Subject: [PATCH 50/79] Simplified IsAssumedRank() and IsAssumedShape() --- flang/include/flang/Evaluate/tools.h | 40 ++++--------------------- flang/lib/Evaluate/check-expression.cpp | 2 +- flang/lib/Evaluate/tools.cpp | 22 +------------- 3 files changed, 8 insertions(+), 56 deletions(-) diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h index 4737e99b50144..f8cb257810f24 100644 --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -84,44 +84,16 @@ template bool IsVariable(const A &x) { // Predicate: true when an expression is assumed-rank bool IsAssumedRank(const Symbol &); -bool IsAssumedRank(const ActualArgument &); -template bool IsAssumedRank(const A &) { return false; } -template bool IsAssumedRank(const Designator &designator) { - if (const auto *symbol{std::get_if(&designator.u)}) { - return IsAssumedRank(symbol->get()); - } else { - return false; - } -} -template bool IsAssumedRank(const Expr &expr) { - return common::visit([](const auto &x) { return IsAssumedRank(x); }, expr.u); -} -template bool IsAssumedRank(const std::optional &x) { - return x && IsAssumedRank(*x); -} -template bool IsAssumedRank(const A *x) { - return x && IsAssumedRank(*x); +template bool IsAssumedRank(const A &x) { + auto *symbol{UnwrapWholeSymbolDataRef(x)}; + return symbol && IsAssumedRank(*symbol); } // Predicate: true when an expression is assumed-shape bool IsAssumedShape(const Symbol &); -bool IsAssumedShape(const ActualArgument &); -template bool IsAssumedShape(const A &) { return false; } -template bool IsAssumedShape(const Designator &designator) { - if (const auto *symbol{std::get_if(&designator.u)}) { - return evaluate::IsAssumedShape(symbol->get()); - } else { - return false; - } -} -template bool IsAssumedShape(const Expr &expr) { - return common::visit([](const auto &x) { return IsAssumedShape(x); }, expr.u); -} -template bool IsAssumedShape(const std::optional &x) { - return x && IsAssumedShape(*x); -} -template bool IsAssumedShape(const A *x) { - return x && IsAssumedShape(*x); +template bool IsAssumedShape(const A &x) { + auto *symbol{UnwrapWholeSymbolDataRef(x)}; + return symbol && IsAssumedShape(*symbol); } // Finds the corank of an entity, possibly packaged in various ways. diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index d34c1381e6b28..0ba12c42e9911 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1565,7 +1565,7 @@ std::pair MayNeedCopyInOut(const ActualArgument &actual, // the actual argument could be polymorphic array of child type, // while the dummy argument could be non-polymorphic array of parent type.) auto actualType{characteristics::TypeAndShape::Characterize(actual, fc)}; - bool actualIsPolymorphic{actualType->type().IsPolymorphic()}; + bool actualIsPolymorphic{actualType && actualType->type().IsPolymorphic()}; if (actualIsPolymorphic && !dummyIsPolymorphic) { setCopyIn(); setCopyOut(); diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp index 175f1e4ecfdb1..d763eb49ae367 100644 --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -903,16 +903,6 @@ bool IsAssumedRank(const Symbol &original) { 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); - } -} - bool IsAssumedShape(const Symbol &symbol) { const Symbol &ultimate{ResolveAssociations(symbol)}; const auto *object{ultimate.detailsIf()}; @@ -920,16 +910,6 @@ bool IsAssumedShape(const Symbol &symbol) { !semantics::IsAllocatableOrObjectPointer(&ultimate); } -bool IsAssumedShape(const ActualArgument &arg) { - if (const auto *expr{arg.UnwrapExpr()}) { - return IsAssumedShape(*expr); - } else { - const Symbol *assumedTypeDummy{arg.GetAssumedTypeDummy()}; - CHECK(assumedTypeDummy); - return IsAssumedShape(*assumedTypeDummy); - } -} - int GetCorank(const ActualArgument &arg) { const auto *expr{arg.UnwrapExpr()}; return GetCorank(*expr); @@ -1221,7 +1201,7 @@ bool HasVectorSubscript(const Expr &expr) { } bool HasVectorSubscript(const ActualArgument &actual) { - auto expr = actual.UnwrapExpr(); + auto expr{actual.UnwrapExpr()}; return expr && HasVectorSubscript(*expr); } From 0239c1d2601f53e42ea9eb567586573969abfd9a Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Tue, 19 Aug 2025 13:45:40 -0400 Subject: [PATCH 51/79] Moved IsAssumedRank() and IsAssumedShape() to namespace Fortran::semantics --- flang/include/flang/Evaluate/tools.h | 27 +++++++------- flang/lib/Evaluate/check-expression.cpp | 4 +-- flang/lib/Evaluate/fold-integer.cpp | 10 +++--- flang/lib/Evaluate/intrinsics.cpp | 4 +-- flang/lib/Evaluate/shape.cpp | 2 +- flang/lib/Evaluate/tools.cpp | 40 ++++++++++----------- flang/lib/Lower/ConvertExpr.cpp | 2 +- flang/lib/Lower/ConvertVariable.cpp | 6 ++-- flang/lib/Lower/HostAssociations.cpp | 4 +-- flang/lib/Semantics/check-allocate.cpp | 2 +- flang/lib/Semantics/check-call.cpp | 12 +++---- flang/lib/Semantics/check-declarations.cpp | 16 ++++----- flang/lib/Semantics/check-omp-loop.cpp | 2 +- flang/lib/Semantics/check-omp-structure.cpp | 2 +- flang/lib/Semantics/check-select-rank.cpp | 2 +- flang/lib/Semantics/check-select-type.cpp | 2 +- flang/lib/Semantics/expression.cpp | 2 +- flang/lib/Semantics/pointer-assignment.cpp | 2 +- flang/lib/Semantics/resolve-directives.cpp | 4 +-- flang/lib/Semantics/resolve-names.cpp | 2 +- flang/lib/Semantics/tools.cpp | 6 ++-- 21 files changed, 76 insertions(+), 77 deletions(-) diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h index f8cb257810f24..e20af008b1baf 100644 --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -82,20 +82,6 @@ template bool IsVariable(const A &x) { } } -// Predicate: true when an expression is assumed-rank -bool IsAssumedRank(const Symbol &); -template bool IsAssumedRank(const A &x) { - auto *symbol{UnwrapWholeSymbolDataRef(x)}; - return symbol && IsAssumedRank(*symbol); -} - -// Predicate: true when an expression is assumed-shape -bool IsAssumedShape(const Symbol &); -template bool IsAssumedShape(const A &x) { - auto *symbol{UnwrapWholeSymbolDataRef(x)}; - return symbol && IsAssumedShape(*symbol); -} - // Finds the corank of an entity, possibly packaged in various ways. // Unlike rank, only data references have corank > 0. int GetCorank(const ActualArgument &); @@ -1549,6 +1535,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 bool IsAssumedRank(const A &x) { + auto *symbol{UnwrapWholeSymbolDataRef(x)}; + return symbol && IsAssumedRank(*symbol); +} + +bool IsAssumedShape(const Symbol &); +template 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 0ba12c42e9911..2b4123c831878 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1501,7 +1501,7 @@ std::pair MayNeedCopyInOut(const ActualArgument &actual, } // All the checks below are for arrays - bool actualIsAssumedRank{evaluate::IsAssumedRank(actual)}; + bool actualIsAssumedRank{semantics::IsAssumedRank(actual)}; bool actualIsArray{actualIsAssumedRank || actual.Rank() > 0}; bool dummyIsAssumedRank{dummyObj->type.attrs().test( characteristics::TypeAndShape::Attr::AssumedRank)}; @@ -1554,7 +1554,7 @@ std::pair MayNeedCopyInOut(const ActualArgument &actual, bool dummyIsAssumedShape{dummyObj->type.attrs().test( characteristics::TypeAndShape::Attr::AssumedShape)}; - bool actualIsAssumedShape{IsAssumedShape(actual)}; + bool actualIsAssumedShape{semantics::IsAssumedShape(actual)}; if ((actualIsAssumedRank && dummyIsAssumedRank) || (actualIsAssumedShape && dummyIsAssumedShape)) { // Assumed-rank and assumed-shape arrays are represented by descriptors, 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 &dimArg, const Expr &array, parser::ContextualMessages &messages, bool isLBound, std::optional &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 &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> LBOUND(FoldingContext &context, return Expr{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> UBOUND(FoldingContext &context, return Expr{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 0f79ba6ed62b6..a89c13d220f90 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -2256,7 +2256,7 @@ std::optional 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(), @@ -3002,7 +3002,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 894049f32a6bf..07bff1034f288 100644 --- a/flang/lib/Evaluate/shape.cpp +++ b/flang/lib/Evaluate/shape.cpp @@ -949,7 +949,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 d763eb49ae367..aee7457b2566a 100644 --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -890,26 +890,6 @@ std::optional> ConvertToType( } } -bool IsAssumedRank(const Symbol &original) { - if (const auto *assoc{original.detailsIf()}) { - 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()}; - return object && object->IsAssumedRank(); -} - -bool IsAssumedShape(const Symbol &symbol) { - const Symbol &ultimate{ResolveAssociations(symbol)}; - const auto *object{ultimate.detailsIf()}; - return object && object->IsAssumedShape() && - !semantics::IsAllocatableOrObjectPointer(&ultimate); -} - int GetCorank(const ActualArgument &arg) { const auto *expr{arg.UnwrapExpr()}; return GetCorank(*expr); @@ -2314,6 +2294,26 @@ bool IsDummy(const Symbol &symbol) { ResolveAssociations(symbol).details()); } +bool IsAssumedRank(const Symbol &original) { + if (const auto *assoc{original.detailsIf()}) { + 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()}; + return object && object->IsAssumedRank(); +} + +bool IsAssumedShape(const Symbol &symbol) { + const Symbol &ultimate{ResolveAssociations(symbol)}; + const auto *object{ultimate.detailsIf()}; + return object && object->IsAssumedShape() && + !semantics::IsAllocatableOrObjectPointer(&ultimate); +} + bool IsDeferredShape(const Symbol &symbol) { const Symbol &ultimate{ResolveAssociations(symbol)}; const auto *object{ultimate.detailsIf()}; diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 5588f62e7a0c1..d7f94e1f7ca6a 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -2750,7 +2750,7 @@ class ScalarExprLowering { fir::unwrapSequenceType(fir::unwrapPassByRefType(argTy)))) TODO(loc, "passing to an OPTIONAL CONTIGUOUS derived type argument " "with length parameters"); - if (Fortran::evaluate::IsAssumedRank(*expr)) + if (Fortran::semantics::IsAssumedRank(*expr)) TODO(loc, "passing an assumed rank entity to an OPTIONAL " "CONTIGUOUS argument"); // Assumed shape VALUE are currently TODO in the call interface diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp index 2cd666b85bb21..80af7f4c1aaad 100644 --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -1111,7 +1111,7 @@ static bool needsRepack(Fortran::lower::AbstractConverter &converter, const auto &attrs = sym.attrs(); if (!converter.getLoweringOptions().getRepackArrays() || !converter.isRegisteredDummySymbol(sym) || - !Fortran::evaluate::IsAssumedShape(sym) || + !Fortran::semantics::IsAssumedShape(sym) || Fortran::evaluate::IsSimplyContiguous(sym, converter.getFoldingContext()) || // TARGET dummy may be accessed indirectly, so it is unsafe @@ -1720,7 +1720,7 @@ static bool lowerToBoxValue(const Fortran::semantics::Symbol &sym, return true; // Assumed rank and optional fir.box cannot yet be read while lowering the // specifications. - if (Fortran::evaluate::IsAssumedRank(sym) || + if (Fortran::semantics::IsAssumedRank(sym) || Fortran::semantics::IsOptional(sym)) return true; // Polymorphic entity should be tracked through a fir.box that has the @@ -2172,7 +2172,7 @@ void Fortran::lower::mapSymbolAttributes( return; } - const bool isAssumedRank = Fortran::evaluate::IsAssumedRank(sym); + const bool isAssumedRank = Fortran::semantics::IsAssumedRank(sym); if (isAssumedRank && !allowAssumedRank) TODO(loc, "assumed-rank variable in procedure implemented in Fortran"); diff --git a/flang/lib/Lower/HostAssociations.cpp b/flang/lib/Lower/HostAssociations.cpp index 2a330ccc4eebb..ad6aba1d28ae4 100644 --- a/flang/lib/Lower/HostAssociations.cpp +++ b/flang/lib/Lower/HostAssociations.cpp @@ -431,7 +431,7 @@ class CapturedArrays : public CapturedSymbols { mlir::Value box = args.valueInTuple; mlir::IndexType idxTy = builder.getIndexType(); llvm::SmallVector lbounds; - if (!ba.lboundIsAllOnes() && !Fortran::evaluate::IsAssumedRank(sym)) { + if (!ba.lboundIsAllOnes() && !Fortran::semantics::IsAssumedRank(sym)) { if (ba.isStaticArray()) { for (std::int64_t lb : ba.staticLBound()) lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, lb)); @@ -490,7 +490,7 @@ class CapturedArrays : public CapturedSymbols { bool isPolymorphic = type && type->IsPolymorphic(); return isScalarOrContiguous && !isPolymorphic && !isDerivedWithLenParameters(sym) && - !Fortran::evaluate::IsAssumedRank(sym); + !Fortran::semantics::IsAssumedRank(sym); } }; } // namespace diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp index 08053594c12e4..823aa4e795e35 100644 --- a/flang/lib/Semantics/check-allocate.cpp +++ b/flang/lib/Semantics/check-allocate.cpp @@ -548,7 +548,7 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) { } } // Shape related checks - if (ultimate_ && evaluate::IsAssumedRank(*ultimate_)) { + if (ultimate_ && IsAssumedRank(*ultimate_)) { context.Say(name_.source, "An assumed-rank dummy argument may not appear in an ALLOCATE statement"_err_en_US); return false; diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp index 70e79df42cb6e..fbd23b4385185 100644 --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -67,7 +67,7 @@ static void CheckImplicitInterfaceArg(evaluate::ActualArgument &arg, "Null pointer argument requires an explicit interface"_err_en_US); } else if (auto named{evaluate::ExtractNamedEntity(*expr)}) { const Symbol &symbol{named->GetLastSymbol()}; - if (evaluate::IsAssumedRank(symbol)) { + if (IsAssumedRank(symbol)) { messages.Say( "Assumed rank argument requires an explicit interface"_err_en_US); } @@ -131,7 +131,7 @@ static void CheckCharacterActual(evaluate::Expr &actual, dummy.type.type().kind() == actualType.type().kind() && !dummy.attrs.test( characteristics::DummyDataObject::Attr::DeducedFromActual)) { - bool actualIsAssumedRank{evaluate::IsAssumedRank(actual)}; + bool actualIsAssumedRank{IsAssumedRank(actual)}; if (actualIsAssumedRank && !dummy.type.attrs().test( characteristics::TypeAndShape::Attr::AssumedRank)) { @@ -387,7 +387,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, characteristics::TypeAndShape::Attr::AssumedRank)}; bool actualIsAssumedSize{actualType.attrs().test( characteristics::TypeAndShape::Attr::AssumedSize)}; - bool actualIsAssumedRank{evaluate::IsAssumedRank(actual)}; + bool actualIsAssumedRank{IsAssumedRank(actual)}; bool actualIsPointer{evaluate::IsObjectPointer(actual)}; bool actualIsAllocatable{evaluate::IsAllocatableDesignator(actual)}; bool actualMayBeAssumedSize{actualIsAssumedSize || @@ -600,7 +600,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, "Element of pointer array may not be associated with a %s array"_err_en_US, dummyName); } - } else if (evaluate::IsAssumedShape(*actualLastSymbol) && + } else if (IsAssumedShape(*actualLastSymbol) && !dummy.ignoreTKR.test(common::IgnoreTKR::Contiguous)) { if (isOkBecauseContiguous) { context.Warn( @@ -1390,8 +1390,8 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg, assumed.name(), dummyName); } else if (object.type.attrs().test(characteristics:: TypeAndShape::Attr::AssumedRank) && - !evaluate::IsAssumedShape(assumed) && - !evaluate::IsAssumedRank(assumed)) { + !IsAssumedShape(assumed) && + !IsAssumedRank(assumed)) { messages.Say( // C711 "Assumed-type '%s' must be either assumed shape or assumed rank to be associated with assumed rank %s"_err_en_US, assumed.name(), dummyName); diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index d44421f05f0a4..3793fbcb9b3c2 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -633,7 +633,7 @@ void CheckHelper::CheckValue( "VALUE attribute may not apply to a type with a coarray ultimate component"_err_en_US); } } - if (evaluate::IsAssumedRank(symbol)) { + if (IsAssumedRank(symbol)) { messages_.Say( "VALUE attribute may not apply to an assumed-rank array"_err_en_US); } @@ -743,7 +743,7 @@ void CheckHelper::CheckObjectEntity( "Coarray '%s' may not have type TEAM_TYPE, C_PTR, or C_FUNPTR"_err_en_US, symbol.name()); } - if (evaluate::IsAssumedRank(symbol)) { + if (IsAssumedRank(symbol)) { messages_.Say("Coarray '%s' may not be an assumed-rank array"_err_en_US, symbol.name()); } @@ -889,7 +889,7 @@ void CheckHelper::CheckObjectEntity( "!DIR$ IGNORE_TKR may not apply to an allocatable or pointer"_err_en_US); } } else if (ignoreTKR.test(common::IgnoreTKR::Rank)) { - if (ignoreTKR.count() == 1 && evaluate::IsAssumedRank(symbol)) { + if (ignoreTKR.count() == 1 && IsAssumedRank(symbol)) { Warn(common::UsageWarning::IgnoreTKRUsage, "!DIR$ IGNORE_TKR(R) is not meaningful for an assumed-rank array"_warn_en_US); } else if (inExplicitExternalInterface) { @@ -1206,7 +1206,7 @@ void CheckHelper::CheckObjectEntity( if (derived && derived->IsVectorType()) { CHECK(type); std::string typeName{type->AsFortran()}; - if (evaluate::IsAssumedShape(symbol)) { + if (IsAssumedShape(symbol)) { SayWithDeclaration(symbol, "Assumed-shape entity of %s type is not supported"_err_en_US, typeName); @@ -1214,7 +1214,7 @@ void CheckHelper::CheckObjectEntity( SayWithDeclaration(symbol, "Deferred-shape entity of %s type is not supported"_err_en_US, typeName); - } else if (evaluate::IsAssumedRank(symbol)) { + } else if (IsAssumedRank(symbol)) { SayWithDeclaration(symbol, "Assumed rank entity of %s type is not supported"_err_en_US, typeName); @@ -2428,8 +2428,8 @@ void CheckHelper::CheckVolatile(const Symbol &symbol, void CheckHelper::CheckContiguous(const Symbol &symbol) { if (evaluate::IsVariable(symbol) && ((IsPointer(symbol) && symbol.Rank() > 0) || - evaluate::IsAssumedShape(symbol) || - evaluate::IsAssumedRank(symbol))) { + IsAssumedShape(symbol) || + IsAssumedRank(symbol))) { } else { parser::MessageFixedText msg{symbol.owner().IsDerivedType() ? "CONTIGUOUS component '%s' should be an array with the POINTER attribute"_port_en_US @@ -3460,7 +3460,7 @@ void CheckHelper::CheckBindC(const Symbol &symbol) { bool CheckHelper::CheckDioDummyIsData( const Symbol &subp, const Symbol *arg, std::size_t position) { if (arg && arg->detailsIf()) { - if (evaluate::IsAssumedRank(*arg)) { + if (IsAssumedRank(*arg)) { messages_.Say(arg->name(), "Dummy argument '%s' may not be assumed-rank"_err_en_US, arg->name()); return false; diff --git a/flang/lib/Semantics/check-omp-loop.cpp b/flang/lib/Semantics/check-omp-loop.cpp index 166462da2fbb3..8dad1f5d605e7 100644 --- a/flang/lib/Semantics/check-omp-loop.cpp +++ b/flang/lib/Semantics/check-omp-loop.cpp @@ -590,7 +590,7 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Linear &x) { if (linearMod->v != parser::OmpLinearModifier::Value::Ref) { CheckIntegerNoRef(symbol, source); } else { - if (!IsAllocatable(*symbol) && !evaluate::IsAssumedShape(*symbol) && + if (!IsAllocatable(*symbol) && !IsAssumedShape(*symbol) && !IsPolymorphic(*symbol)) { context_.Say(source, "The list item `%s` specified with the REF '%s' must be polymorphic variable, assumed-shape array, or a variable with the `ALLOCATABLE` attribute"_err_en_US, diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index d9092565449da..d8afd4a48fec8 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -3008,7 +3008,7 @@ void OmpStructureChecker::CheckReductionObjectTypes( // r = 0; r = r + r2 // But it might be valid to use these with DECLARE REDUCTION. // Assumed size is already caught elsewhere. - bool cannotBeBuiltinReduction{evaluate::IsAssumedRank(*symbol)}; + bool cannotBeBuiltinReduction{IsAssumedRank(*symbol)}; if (auto *type{symbol->GetType()}) { const auto &scope{context_.FindScope(symbol->name())}; if (!IsReductionAllowedForType( diff --git a/flang/lib/Semantics/check-select-rank.cpp b/flang/lib/Semantics/check-select-rank.cpp index b227bbaaef4ba..5dade2ca696c1 100644 --- a/flang/lib/Semantics/check-select-rank.cpp +++ b/flang/lib/Semantics/check-select-rank.cpp @@ -32,7 +32,7 @@ void SelectRankConstructChecker::Leave( const Symbol *saveSelSymbol{nullptr}; if (const auto selExpr{GetExprFromSelector(selectRankStmtSel)}) { if (const Symbol * sel{evaluate::UnwrapWholeSymbolDataRef(*selExpr)}) { - if (!evaluate::IsAssumedRank(*sel)) { // C1150 + if (!semantics::IsAssumedRank(*sel)) { // C1150 context_.Say(parser::FindSourceLocation(selectRankStmtSel), "Selector '%s' is not an assumed-rank array variable"_err_en_US, sel->name().ToString()); diff --git a/flang/lib/Semantics/check-select-type.cpp b/flang/lib/Semantics/check-select-type.cpp index 94d16a719277a..b1b22c3e7c4a2 100644 --- a/flang/lib/Semantics/check-select-type.cpp +++ b/flang/lib/Semantics/check-select-type.cpp @@ -252,7 +252,7 @@ void SelectTypeChecker::Enter(const parser::SelectTypeConstruct &construct) { if (IsProcedure(*selector)) { context_.Say( selectTypeStmt.source, "Selector may not be a procedure"_err_en_US); - } else if (evaluate::IsAssumedRank(*selector)) { + } else if (IsAssumedRank(*selector)) { context_.Say(selectTypeStmt.source, "Assumed-rank variable may only be used as actual argument"_err_en_US); } else if (auto exprType{selector->GetType()}) { diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index d022378ce1455..c1f01a0af94fa 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -4632,7 +4632,7 @@ bool ArgumentAnalyzer::CheckForNullPointer(const char *where) { bool ArgumentAnalyzer::CheckForAssumedRank(const char *where) { for (const std::optional &arg : actuals_) { - if (arg && IsAssumedRank(arg->UnwrapExpr())) { + if (arg && semantics::IsAssumedRank(arg->UnwrapExpr())) { context_.Say(source_, "An assumed-rank dummy argument is not allowed %s"_err_en_US, where); fatalErrors_ = true; diff --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp index e767bf840957c..5508ba8378949 100644 --- a/flang/lib/Semantics/pointer-assignment.cpp +++ b/flang/lib/Semantics/pointer-assignment.cpp @@ -159,7 +159,7 @@ bool PointerAssignmentChecker::CheckLeftHandSide(const SomeExpr &lhs) { msg->Attach(std::move(whyNot->set_severity(parser::Severity::Because))); } return false; - } else if (evaluate::IsAssumedRank(lhs)) { + } else if (IsAssumedRank(lhs)) { Say("The left-hand side of a pointer assignment must not be an assumed-rank dummy argument"_err_en_US); return false; } else if (evaluate::ExtractCoarrayRef(lhs)) { // F'2023 C1027 diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp index 5a244e5183e39..4ba10c4ee794f 100644 --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -2438,7 +2438,7 @@ static bool IsTargetCaptureImplicitlyFirstprivatizeable(const Symbol &symbol, // investigate the flags we can intermix with. if (!(dsa & (dataSharingAttributeFlags | dataMappingAttributeFlags)) .none() || - !checkSym.flags().none() || evaluate::IsAssumedShape(checkSym) || + !checkSym.flags().none() || IsAssumedShape(checkSym) || semantics::IsAllocatableOrPointer(checkSym)) { return false; } @@ -3165,7 +3165,7 @@ static bool IsSymbolPrivate(const Symbol &symbol) { case Scope::Kind::BlockConstruct: return !symbol.attrs().test(Attr::SAVE) && !symbol.attrs().test(Attr::PARAMETER) && - !evaluate::IsAssumedShape(symbol) && + !IsAssumedShape(symbol) && !symbol.flags().test(Symbol::Flag::InCommonBlock); default: return false; diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 5808b4b3cc4fe..f7adbbab0e7ee 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -7913,7 +7913,7 @@ void ConstructVisitor::Post(const parser::AssociateStmt &x) { if (ExtractCoarrayRef(expr)) { // C1103 Say("Selector must not be a coindexed object"_err_en_US); } - if (evaluate::IsAssumedRank(expr)) { + if (IsAssumedRank(expr)) { Say("Selector must not be assumed-rank"_err_en_US); } SetTypeFromAssociation(*symbol); diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp index 913bf08cd0d99..e9b1d0d7795e1 100644 --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -705,7 +705,7 @@ SymbolVector FinalsForDerivedTypeInstantiation(const DerivedTypeSpec &spec) { const Symbol *IsFinalizable(const Symbol &symbol, std::set *inProgress, bool withImpureFinalizer) { - if (IsPointer(symbol) || evaluate::IsAssumedRank(symbol)) { + if (IsPointer(symbol) || IsAssumedRank(symbol)) { return nullptr; } if (const auto *object{symbol.detailsIf()}) { @@ -741,7 +741,7 @@ const Symbol *IsFinalizable(const DerivedTypeSpec &derived, if (const SubprogramDetails * subp{symbol->detailsIf()}) { if (const auto &args{subp->dummyArgs()}; !args.empty() && - args.at(0) && !evaluate::IsAssumedRank(*args.at(0)) && + args.at(0) && !IsAssumedRank(*args.at(0)) && args.at(0)->Rank() != *rank) { continue; // not a finalizer for this rank } @@ -790,7 +790,7 @@ const Symbol *HasImpureFinal(const Symbol &original, std::optional rank) { if (symbol.has()) { if (const DeclTypeSpec * symType{symbol.GetType()}) { if (const DerivedTypeSpec * derived{symType->AsDerived()}) { - if (evaluate::IsAssumedRank(symbol)) { + if (IsAssumedRank(symbol)) { // finalizable assumed-rank not allowed (C839) return nullptr; } else { From 0faca169e0ff1ce9fa44870873c32a43197dd200 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Tue, 19 Aug 2025 13:55:44 -0400 Subject: [PATCH 52/79] clang-format --- flang/lib/Semantics/check-call.cpp | 3 +-- flang/lib/Semantics/check-declarations.cpp | 3 +-- flang/lib/Semantics/resolve-directives.cpp | 3 +-- 3 files changed, 3 insertions(+), 6 deletions(-) diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp index fbd23b4385185..681f87f1d28e7 100644 --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -1390,8 +1390,7 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg, assumed.name(), dummyName); } else if (object.type.attrs().test(characteristics:: TypeAndShape::Attr::AssumedRank) && - !IsAssumedShape(assumed) && - !IsAssumedRank(assumed)) { + !IsAssumedShape(assumed) && !IsAssumedRank(assumed)) { messages.Say( // C711 "Assumed-type '%s' must be either assumed shape or assumed rank to be associated with assumed rank %s"_err_en_US, assumed.name(), dummyName); diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index 3793fbcb9b3c2..007d678f931ec 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -2427,8 +2427,7 @@ void CheckHelper::CheckVolatile(const Symbol &symbol, void CheckHelper::CheckContiguous(const Symbol &symbol) { if (evaluate::IsVariable(symbol) && - ((IsPointer(symbol) && symbol.Rank() > 0) || - IsAssumedShape(symbol) || + ((IsPointer(symbol) && symbol.Rank() > 0) || IsAssumedShape(symbol) || IsAssumedRank(symbol))) { } else { parser::MessageFixedText msg{symbol.owner().IsDerivedType() diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp index e1ad63157a633..c38df0ea38e88 100644 --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -3165,8 +3165,7 @@ static bool IsSymbolPrivate(const Symbol &symbol) { case Scope::Kind::Subprogram: case Scope::Kind::BlockConstruct: return !symbol.attrs().test(Attr::SAVE) && - !symbol.attrs().test(Attr::PARAMETER) && - !IsAssumedShape(symbol) && + !symbol.attrs().test(Attr::PARAMETER) && !IsAssumedShape(symbol) && !symbol.flags().test(Symbol::Flag::InCommonBlock); default: return false; From 450a5d7310e06294c89eb84afb42a398cce25836 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Tue, 19 Aug 2025 21:49:06 -0400 Subject: [PATCH 53/79] WIP: new API MayNeedCopy() --- flang/include/flang/Evaluate/call.h | 1 + .../include/flang/Evaluate/characteristics.h | 1 + .../include/flang/Evaluate/check-expression.h | 3 + flang/lib/Evaluate/call.cpp | 4 + flang/lib/Evaluate/characteristics.cpp | 5 + flang/lib/Evaluate/check-expression.cpp | 92 +++++++++++++++++++ 6 files changed, 106 insertions(+) diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h index 2a5929b873d74..8f2abf72a1183 100644 --- a/flang/include/flang/Evaluate/call.h +++ b/flang/include/flang/Evaluate/call.h @@ -110,6 +110,7 @@ class ActualArgument { std::optional GetType() const; int Rank() const; + bool IsArray() const ; bool operator==(const ActualArgument &) const; llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const; diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h index b6a9ebefec9df..ab0316c00dc76 100644 --- a/flang/include/flang/Evaluate/characteristics.h +++ b/flang/include/flang/Evaluate/characteristics.h @@ -254,6 +254,7 @@ struct DummyDataObject { bool CanBePassedViaImplicitInterface(std::string *whyNot = nullptr) const; bool IsPassedByDescriptor(bool isBindC) const; llvm::raw_ostream &Dump(llvm::raw_ostream &) const; + bool IsArray() const; TypeAndShape type; std::vector> coshape; diff --git a/flang/include/flang/Evaluate/check-expression.h b/flang/include/flang/Evaluate/check-expression.h index ac1e1549a99fb..517f0fc4b02bc 100644 --- a/flang/include/flang/Evaluate/check-expression.h +++ b/flang/include/flang/Evaluate/check-expression.h @@ -163,6 +163,9 @@ extern template bool IsErrorExpr(const Expr &); std::optional CheckStatementFunction( const Symbol &, const Expr &, FoldingContext &); +bool MayNeedCopy(const ActualArgument *, const characteristics::DummyArgument *, + FoldingContext &, bool); + // Returns a pair of Booleans. The first boolean specifies whether given actual // argument may need copy-in operation and the second Boolean specifies whether // copy-out may be necessary. This function works with implicit interface diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index f77df92a7597a..9648b2f2d91b2 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -56,6 +56,10 @@ int ActualArgument::Rank() const { } } +bool ActualArgument::IsArray() const { + return semantics::IsAssumedRank(*this) || Rank() > 0; +} + bool ActualArgument::operator==(const ActualArgument &that) const { return keyword_ == that.keyword_ && attrs_ == that.attrs_ && u_ == that.u_; } diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp index 37c62c93a87df..9753b367510e2 100644 --- a/flang/lib/Evaluate/characteristics.cpp +++ b/flang/lib/Evaluate/characteristics.cpp @@ -530,6 +530,11 @@ bool DummyDataObject::IsPassedByDescriptor(bool isBindC) const { return false; } +bool DummyDataObject::IsArray() const { + return type.attrs().test(characteristics::TypeAndShape::Attr::AssumedRank) || + type.Rank() > 0; +} + llvm::raw_ostream &DummyDataObject::Dump(llvm::raw_ostream &o) const { attrs.Dump(o, EnumToString); if (intent != common::Intent::Default) { diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index 2b4123c831878..379f97afd3ee6 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1575,4 +1575,96 @@ std::pair MayNeedCopyInOut(const ActualArgument &actual, return {mayNeedCopyIn, mayNeedCopyOut}; } +// Copy-in determination for implicit interface +static bool MayNeedCopyIn(const ActualArgument& actual, FoldingContext& fc) { + if (!evaluate::IsVariable(actual)) { + // Actual argument expressions that aren’t variables are copy-in, but + // not copy-out. + return true; + } + if (actual.IsArray() && !IsSimplyContiguous(actual, fc)) { + // Actual arguments that are variables are copy-in when non-contiguous. + return true; + } + return false; +} + +// Copy-out determination for implicit interface +static bool MayNeedCopyOut(const ActualArgument& actual, FoldingContext& fc) { + if (actual.IsArray() && evaluate::IsVariable(actual) && + !IsSimplyContiguous(actual, fc) && !HasVectorSubscript(actual)) { + // Actual arguments that are non-contiguous array variables are copy-out + // when don't have vector subscripts + return true; + } + return false; +} + +// Copy-in determination for explicit interface +static bool MayNeedCopyIn(const ActualArgument& actual, + const characteristics::DummyDataObject &dummyObj, + FoldingContext& fc) { + if (dummyObj.intent == common::Intent::Out) { + // INTENT(OUT) dummy args never need copy-in + return false; + } + if (dummyObj.attrs.test(characteristics::DummyDataObject::Attr::Value)) { + // Pass by value, always copy-in, never copy-out + return true; + } + + return false; +} + +// Copy-out determination for explicit interface +static bool MayNeedCopyOut(const ActualArgument& actual, + const characteristics::DummyDataObject &dummyObj, + FoldingContext& fc) { + if (dummyObj.intent == common::Intent::Out) { + // INTENT(IN) dummy args never need copy-out + return false; + } + return false; +} + +// TODO: dummy is coarray: dummy.type.corank() > 0 + +// 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. +bool MayNeedCopy(const ActualArgument *actual, + const characteristics::DummyArgument *dummy, + FoldingContext &fc, bool forCopyOut) { + if (!actual) { + return false; + } + if (actual->isAlternateReturn()) { + return false; + } + if (!dummy) { // Implicit interface + if (ExtractCoarrayRef(actual)) { + // Coindexed actual args need copy-in and copy-out + return true; + } + if (forCopyOut) { + return MayNeedCopyOut(*actual, fc); + } else { + return MayNeedCopyIn(*actual, fc); + } + } else { // Explicit interface + const auto *dummyObj{std::get_if(&dummy->u)}; + if (!dummyObj) { + // Only DummyDataObject has the information we need + return false; + } + if (forCopyOut) { + return MayNeedCopyOut(*actual, *dummyObj, fc); + } else { + return MayNeedCopyIn(*actual, *dummyObj, fc); + } + } +} + } // namespace Fortran::evaluate From 0be16a4825dfab5e4310b53ca05032c107f8b3b1 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Tue, 19 Aug 2025 21:57:25 -0400 Subject: [PATCH 54/79] clang-format --- flang/include/flang/Evaluate/call.h | 2 +- flang/lib/Evaluate/check-expression.cpp | 25 ++++++++++++------------- 2 files changed, 13 insertions(+), 14 deletions(-) diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h index 8f2abf72a1183..34266462a77c6 100644 --- a/flang/include/flang/Evaluate/call.h +++ b/flang/include/flang/Evaluate/call.h @@ -110,7 +110,7 @@ class ActualArgument { std::optional GetType() const; int Rank() const; - bool IsArray() const ; + bool IsArray() const; bool operator==(const ActualArgument &) const; llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const; diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index 379f97afd3ee6..a98d6a55aaf84 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1576,7 +1576,7 @@ std::pair MayNeedCopyInOut(const ActualArgument &actual, } // Copy-in determination for implicit interface -static bool MayNeedCopyIn(const ActualArgument& actual, FoldingContext& fc) { +static bool MayNeedCopyIn(const ActualArgument &actual, FoldingContext &fc) { if (!evaluate::IsVariable(actual)) { // Actual argument expressions that aren’t variables are copy-in, but // not copy-out. @@ -1590,7 +1590,7 @@ static bool MayNeedCopyIn(const ActualArgument& actual, FoldingContext& fc) { } // Copy-out determination for implicit interface -static bool MayNeedCopyOut(const ActualArgument& actual, FoldingContext& fc) { +static bool MayNeedCopyOut(const ActualArgument &actual, FoldingContext &fc) { if (actual.IsArray() && evaluate::IsVariable(actual) && !IsSimplyContiguous(actual, fc) && !HasVectorSubscript(actual)) { // Actual arguments that are non-contiguous array variables are copy-out @@ -1601,9 +1601,8 @@ static bool MayNeedCopyOut(const ActualArgument& actual, FoldingContext& fc) { } // Copy-in determination for explicit interface -static bool MayNeedCopyIn(const ActualArgument& actual, - const characteristics::DummyDataObject &dummyObj, - FoldingContext& fc) { +static bool MayNeedCopyIn(const ActualArgument &actual, + const characteristics::DummyDataObject &dummyObj, FoldingContext &fc) { if (dummyObj.intent == common::Intent::Out) { // INTENT(OUT) dummy args never need copy-in return false; @@ -1617,9 +1616,8 @@ static bool MayNeedCopyIn(const ActualArgument& actual, } // Copy-out determination for explicit interface -static bool MayNeedCopyOut(const ActualArgument& actual, - const characteristics::DummyDataObject &dummyObj, - FoldingContext& fc) { +static bool MayNeedCopyOut(const ActualArgument &actual, + const characteristics::DummyDataObject &dummyObj, FoldingContext &fc) { if (dummyObj.intent == common::Intent::Out) { // INTENT(IN) dummy args never need copy-out return false; @@ -1635,15 +1633,15 @@ static bool MayNeedCopyOut(const ActualArgument& actual, // procedures with explicit interface, it's expected that "dummy" is not null. // For procedures with implicit interface dummy may be null. bool MayNeedCopy(const ActualArgument *actual, - const characteristics::DummyArgument *dummy, - FoldingContext &fc, bool forCopyOut) { + const characteristics::DummyArgument *dummy, FoldingContext &fc, + bool forCopyOut) { if (!actual) { return false; } if (actual->isAlternateReturn()) { return false; } - if (!dummy) { // Implicit interface + if (!dummy) { // Implicit interface if (ExtractCoarrayRef(actual)) { // Coindexed actual args need copy-in and copy-out return true; @@ -1653,8 +1651,9 @@ bool MayNeedCopy(const ActualArgument *actual, } else { return MayNeedCopyIn(*actual, fc); } - } else { // Explicit interface - const auto *dummyObj{std::get_if(&dummy->u)}; + } else { // Explicit interface + const auto *dummyObj{ + std::get_if(&dummy->u)}; if (!dummyObj) { // Only DummyDataObject has the information we need return false; From dd9560a05cb8e629dc56ea8c61c6148e8dc38753 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Wed, 20 Aug 2025 11:34:33 -0400 Subject: [PATCH 55/79] Continue implementation of new MayNeedCopy() --- flang/lib/Evaluate/check-expression.cpp | 98 +++++++++++++++++++++---- 1 file changed, 85 insertions(+), 13 deletions(-) diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index a98d6a55aaf84..4c563ead2405e 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1582,22 +1582,27 @@ static bool MayNeedCopyIn(const ActualArgument &actual, FoldingContext &fc) { // not copy-out. return true; } - if (actual.IsArray() && !IsSimplyContiguous(actual, fc)) { + if (!IsSimplyContiguous(actual, fc)) { // Actual arguments that are variables are copy-in when non-contiguous. return true; } + // For everything else assume no copy-in return false; } // Copy-out determination for implicit interface static bool MayNeedCopyOut(const ActualArgument &actual, FoldingContext &fc) { - if (actual.IsArray() && evaluate::IsVariable(actual) && - !IsSimplyContiguous(actual, fc) && !HasVectorSubscript(actual)) { - // Actual arguments that are non-contiguous array variables are copy-out - // when don't have vector subscripts - return true; + if (!evaluate::IsVariable(actual)) { + // Expressions are never copy-out + return false; } - return false; + if (HasVectorSubscript(actual)) { + // Vector subscripts could refer to duplicate elements, can't copy out + return false; + } + // For all other cases may need to copy-out. The final determination of + // whether to copy-out should be made together witih copy-in. + return true; } // Copy-in determination for explicit interface @@ -1611,27 +1616,93 @@ static bool MayNeedCopyIn(const ActualArgument &actual, // Pass by value, always copy-in, never copy-out return true; } - + // Note: checks below deal with array arguments + bool treatDummyScalarAsArray{dummyObj.type.Rank() == 0 && + dummyObj.ignoreTKR.test(common::IgnoreTKR::Rank)}; + if (!actual.IsArray() || !(dummyObj.IsArray() || treatDummyScalarAsArray)) { + return false; + } + // Check actual contiguity, unless dummy doesn't care + 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()}; + // Explicit shape and assumed size arrays must be contiguous + bool dummyNeedsContiguity{dummyIsExplicitShape || dummyIsAssumedSize || + // Polymorphic dummy is descriptor based, so should be able to handle + // discontigunity. + (treatDummyScalarAsArray && !dummyIsPolymorphic) || + dummyObj.attrs.test(characteristics::DummyDataObject::Attr::Contiguous)}; + if (!actualTreatAsContiguous && dummyNeedsContiguity) { + return true; + } + 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.) + auto actualType{characteristics::TypeAndShape::Characterize(actual, fc)}; + bool actualIsPolymorphic{actualType && actualType->type().IsPolymorphic()}; + if (actualIsPolymorphic && !dummyIsPolymorphic) { + return true; + } + } + if (ExtractCoarrayRef(actual) && dummyObj.type.corank() == 0) { + // Actual is a corray variable, dummy is not, should copy-in + return true; + } + // For everything else assume no copy-in return false; } // Copy-out determination for explicit interface static bool MayNeedCopyOut(const ActualArgument &actual, const characteristics::DummyDataObject &dummyObj, FoldingContext &fc) { - if (dummyObj.intent == common::Intent::Out) { + if (dummyObj.intent == common::Intent::In) { // INTENT(IN) dummy args never need copy-out return false; } - return false; + if (dummyObj.attrs.test(characteristics::DummyDataObject::Attr::Value)) { + // Pass by value, never copy-out + return false; + } + if (!evaluate::IsVariable(actual)) { + // Expressions are never copy-out + return false; + } + if (HasVectorSubscript(actual)) { + // Vector subscripts could refer to duplicate elements, can't copy out + return false; + } + if (ExtractCoarrayRef(actual) && dummyObj.type.corank() > 0) { + return false; + } + // For all other cases may need to copy-out. The final determination of + // whether to copy-out should be made together witih copy-in. + return true; } -// TODO: dummy is coarray: dummy.type.corank() > 0 - // 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 ultimate decisions about whether copy-out is necessary may +// depend on whether copy-in was necessary. bool MayNeedCopy(const ActualArgument *actual, const characteristics::DummyArgument *dummy, FoldingContext &fc, bool forCopyOut) { @@ -1643,7 +1714,8 @@ bool MayNeedCopy(const ActualArgument *actual, } if (!dummy) { // Implicit interface if (ExtractCoarrayRef(actual)) { - // Coindexed actual args need copy-in and copy-out + // Coindexed actual args may need copy-in and copy-out with implicit + // interface return true; } if (forCopyOut) { From a8c4dcfaee06a1bb68027d0aa48c31fa4f6499f9 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Wed, 20 Aug 2025 14:30:43 -0400 Subject: [PATCH 56/79] Assumed type check for contiguity --- flang/lib/Evaluate/check-expression.cpp | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index 4c563ead2405e..6daf2f0f9d695 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1536,11 +1536,16 @@ std::pair MayNeedCopyInOut(const ActualArgument &actual, bool dummyIsAssumedSize{dummyObj->type.attrs().test( characteristics::TypeAndShape::Attr::AssumedSize)}; bool dummyIsPolymorphic{dummyObj->type.type().IsPolymorphic()}; + bool dummyIsAssumedType{dummyObj->type.type().IsAssumedType()}; // Explicit shape and assumed size arrays must be contiguous bool dummyNeedsContiguity{dummyIsExplicitShape || dummyIsAssumedSize || + // We cannot make assumptions about assumed type dummy args, especially + // if they are used as stand-ins for C "void*", thus assume that need + // contiguity. + // // Polymorphic dummy is descriptor based, so should be able to handle // discontigunity. - (treatDummyScalarAsArray && !dummyIsPolymorphic) || + dummyIsAssumedType || (treatDummyScalarAsArray && !dummyIsPolymorphic) || dummyObj->attrs.test(characteristics::DummyDataObject::Attr::Contiguous)}; if (!actualTreatAsContiguous && dummyNeedsContiguity) { setCopyIn(); @@ -1630,11 +1635,16 @@ static bool MayNeedCopyIn(const ActualArgument &actual, bool dummyIsAssumedSize{dummyObj.type.attrs().test( characteristics::TypeAndShape::Attr::AssumedSize)}; bool dummyIsPolymorphic{dummyObj.type.type().IsPolymorphic()}; + bool dummyIsAssumedType{dummyObj.type.type().IsAssumedType()}; // Explicit shape and assumed size arrays must be contiguous bool dummyNeedsContiguity{dummyIsExplicitShape || dummyIsAssumedSize || + // We cannot make assumptions about assumed type dummy args, especially + // if they are used as stand-ins for C "void*", thus decide that need + // contiguity. + // // Polymorphic dummy is descriptor based, so should be able to handle // discontigunity. - (treatDummyScalarAsArray && !dummyIsPolymorphic) || + dummyIsAssumedType || (treatDummyScalarAsArray && !dummyIsPolymorphic) || dummyObj.attrs.test(characteristics::DummyDataObject::Attr::Contiguous)}; if (!actualTreatAsContiguous && dummyNeedsContiguity) { return true; From be85c20b06fcbd29aa696d25c22e3df0348c73d3 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Wed, 20 Aug 2025 17:17:09 -0400 Subject: [PATCH 57/79] Better void* standing for old implementation --- flang/lib/Evaluate/check-expression.cpp | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index 6daf2f0f9d695..5dc20b89c1aa3 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1506,9 +1506,8 @@ std::pair MayNeedCopyInOut(const ActualArgument &actual, bool dummyIsAssumedRank{dummyObj->type.attrs().test( characteristics::TypeAndShape::Attr::AssumedRank)}; bool dummyIsArray{dummyIsAssumedRank || dummyObj->type.Rank() > 0}; - bool treatDummyScalarAsArray{dummyObj->type.Rank() == 0 && - dummyObj->ignoreTKR.test(common::IgnoreTKR::Rank)}; - if (!actualIsArray || !(dummyIsArray || treatDummyScalarAsArray)) { + bool dummyTreatAsArray{dummyObj->ignoreTKR.test(common::IgnoreTKR::Rank)}; + if (!actualIsArray || !(dummyIsArray || dummyTreatAsArray)) { return {mayNeedCopyIn, mayNeedCopyOut}; } @@ -1536,16 +1535,16 @@ std::pair MayNeedCopyInOut(const ActualArgument &actual, bool dummyIsAssumedSize{dummyObj->type.attrs().test( characteristics::TypeAndShape::Attr::AssumedSize)}; bool dummyIsPolymorphic{dummyObj->type.type().IsPolymorphic()}; - bool dummyIsAssumedType{dummyObj->type.type().IsAssumedType()}; + // 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 need to 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 || - // We cannot make assumptions about assumed type dummy args, especially - // if they are used as stand-ins for C "void*", thus assume that need - // contiguity. - // - // Polymorphic dummy is descriptor based, so should be able to handle - // discontigunity. - dummyIsAssumedType || (treatDummyScalarAsArray && !dummyIsPolymorphic) || + (dummyTreatAsArray && !dummyIsPolymorphic) || dummyIsVoidStar || dummyObj->attrs.test(characteristics::DummyDataObject::Attr::Contiguous)}; if (!actualTreatAsContiguous && dummyNeedsContiguity) { setCopyIn(); From 36a3049e915dc5fdfd9f4f4e0350174f552d9db6 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Wed, 20 Aug 2025 17:21:34 -0400 Subject: [PATCH 58/79] clang-format --- flang/lib/Evaluate/check-expression.cpp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index 5dc20b89c1aa3..d7d33fca7eb7f 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1539,9 +1539,9 @@ std::pair MayNeedCopyInOut(const ActualArgument &actual, // Since the other languages don't know about Fortran's discontiguity // handling, such cases need to 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)}; + 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 || From 69d7ca0570b3ca108385b95684369e5a74e0e9cc Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Wed, 20 Aug 2025 18:42:30 -0400 Subject: [PATCH 59/79] Tweaks to MayNeedCopyIn() to bring it closer to the old implementation --- flang/lib/Evaluate/check-expression.cpp | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index d7d33fca7eb7f..50d2f1fb82e2a 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1621,9 +1621,8 @@ static bool MayNeedCopyIn(const ActualArgument &actual, return true; } // Note: checks below deal with array arguments - bool treatDummyScalarAsArray{dummyObj.type.Rank() == 0 && - dummyObj.ignoreTKR.test(common::IgnoreTKR::Rank)}; - if (!actual.IsArray() || !(dummyObj.IsArray() || treatDummyScalarAsArray)) { + bool dummyTreatAsArray{dummyObj.ignoreTKR.test(common::IgnoreTKR::Rank)}; + if (!actual.IsArray() || !(dummyObj.IsArray() || dummyTreatAsArray)) { return false; } // Check actual contiguity, unless dummy doesn't care @@ -1634,16 +1633,16 @@ static bool MayNeedCopyIn(const ActualArgument &actual, bool dummyIsAssumedSize{dummyObj.type.attrs().test( characteristics::TypeAndShape::Attr::AssumedSize)}; bool dummyIsPolymorphic{dummyObj.type.type().IsPolymorphic()}; - bool dummyIsAssumedType{dummyObj.type.type().IsAssumedType()}; + // 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 || - // We cannot make assumptions about assumed type dummy args, especially - // if they are used as stand-ins for C "void*", thus decide that need - // contiguity. - // - // Polymorphic dummy is descriptor based, so should be able to handle - // discontigunity. - dummyIsAssumedType || (treatDummyScalarAsArray && !dummyIsPolymorphic) || + (dummyTreatAsArray && !dummyIsPolymorphic) || dummyIsVoidStar || dummyObj.attrs.test(characteristics::DummyDataObject::Attr::Contiguous)}; if (!actualTreatAsContiguous && dummyNeedsContiguity) { return true; From f6bb3df9420f53d0d593af78e09755a3a8378400 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Wed, 20 Aug 2025 19:43:28 -0400 Subject: [PATCH 60/79] Removed the old implementation (MayNeedCopyInOut) and switched to the new implementation --- .../include/flang/Evaluate/check-expression.h | 26 ---- flang/lib/Evaluate/check-expression.cpp | 133 ------------------ flang/lib/Lower/ConvertCall.cpp | 6 +- 3 files changed, 4 insertions(+), 161 deletions(-) diff --git a/flang/include/flang/Evaluate/check-expression.h b/flang/include/flang/Evaluate/check-expression.h index 517f0fc4b02bc..57ffea2273fa4 100644 --- a/flang/include/flang/Evaluate/check-expression.h +++ b/flang/include/flang/Evaluate/check-expression.h @@ -166,31 +166,5 @@ std::optional CheckStatementFunction( bool MayNeedCopy(const ActualArgument *, const characteristics::DummyArgument *, FoldingContext &, bool); -// Returns a pair of Booleans. The first boolean specifies whether given actual -// argument may need copy-in operation and the second Boolean specifies whether -// copy-out may be necessary. This function works with implicit interface -// procedures. -std::pair MayNeedCopyInOut( - const ActualArgument &, FoldingContext &); - -// Returns a pair of Booleans. The first boolean specifies whether given actual -// and dummy argument pair may need copy-in operation for the actual argument, -// and the second Boolean specifies whether copy-out may be necessary. -// This function works with explicit interface procedures. -std::pair MayNeedCopyInOut(const ActualArgument &, - const characteristics::DummyArgument &, FoldingContext &); - -inline std::pair MayNeedCopyInOut(const ActualArgument *actual, - const characteristics::DummyArgument *dummy, FoldingContext &fc) { - if (!actual) { - return {false, false}; - } - if (dummy) { - return MayNeedCopyInOut(*actual, *dummy, fc); - } else { - return MayNeedCopyInOut(*actual, fc); - } -} - } // namespace Fortran::evaluate #endif diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index 50d2f1fb82e2a..03ec8c8969903 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1446,139 +1446,6 @@ std::optional CheckStatementFunction( return StmtFunctionChecker{sf, context}(expr); } -std::pair MayNeedCopyInOut( - const ActualArgument &actual, FoldingContext &fc) { - bool mayNeedCopyIn{false}; - bool mayNeedCopyOut{false}; - if (actual.isAlternateReturn()) { - return {mayNeedCopyIn, mayNeedCopyOut}; - } - if (!evaluate::IsVariable(actual)) { - // Actual argument expressions that aren’t variables are copy-in, but - // not copy-out. - mayNeedCopyIn = true; - } else if (bool actualIsArray{actual.Rank() > 0}; - actualIsArray && !IsSimplyContiguous(actual, fc)) { - // Actual arguments that are variables are copy-in when non-contiguous. - // They are copy-out when don't have vector subscripts - mayNeedCopyIn = true; - if (!HasVectorSubscript(actual)) { - mayNeedCopyOut = true; - } - } else if (ExtractCoarrayRef(actual)) { - // Coindexed actual args need copy-in and copy-out - mayNeedCopyIn = true; - mayNeedCopyOut = true; - } - - return {mayNeedCopyIn, mayNeedCopyOut}; -} - -std::pair MayNeedCopyInOut(const ActualArgument &actual, - const characteristics::DummyArgument &dummy, FoldingContext &fc) { - bool mayNeedCopyIn{false}; - bool mayNeedCopyOut{false}; - if (actual.isAlternateReturn()) { - return {mayNeedCopyIn, mayNeedCopyOut}; - } - if (!evaluate::IsVariable(actual)) { - // Actual argument expressions that aren’t variables are copy-in, but - // not copy-out. - mayNeedCopyIn = true; - return {mayNeedCopyIn, mayNeedCopyOut}; - } - const auto *dummyObj{std::get_if(&dummy.u)}; - if (!dummyObj) { - // Only DummyDataObject has the information we need - return {mayNeedCopyIn, mayNeedCopyOut}; - } - // Pass by value, always copy-in, never copy-out - bool dummyIsValue{ - dummyObj->attrs.test(characteristics::DummyDataObject::Attr::Value)}; - if (dummyIsValue) { - mayNeedCopyIn = true; - return {mayNeedCopyIn, mayNeedCopyOut}; - } - // All the checks below are for arrays - - bool actualIsAssumedRank{semantics::IsAssumedRank(actual)}; - bool actualIsArray{actualIsAssumedRank || actual.Rank() > 0}; - bool dummyIsAssumedRank{dummyObj->type.attrs().test( - characteristics::TypeAndShape::Attr::AssumedRank)}; - bool dummyIsArray{dummyIsAssumedRank || dummyObj->type.Rank() > 0}; - bool dummyTreatAsArray{dummyObj->ignoreTKR.test(common::IgnoreTKR::Rank)}; - if (!actualIsArray || !(dummyIsArray || dummyTreatAsArray)) { - return {mayNeedCopyIn, mayNeedCopyOut}; - } - - bool dummyIntentIn{dummyObj->intent == common::Intent::In}; - bool dummyIntentOut{dummyObj->intent == common::Intent::Out}; - auto setCopyIn = [&]() { - if (!dummyIntentOut) { - // INTENT(OUT) dummy args never need copy-in - mayNeedCopyIn = true; - } - }; - auto setCopyOut = [&]() { - if (!dummyIntentIn) { - // INTENT(IN) dummy args never need copy-out - mayNeedCopyOut = true; - } - }; - - // Check actual contiguity, unless dummy doesn't care - bool actualTreatAsContiguous{ - dummyObj->ignoreTKR.test(common::IgnoreTKR::Contiguous) || - IsSimplyContiguous(actual, fc)}; - bool actualHasVectorSubscript{HasVectorSubscript(actual)}; - 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 need to 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)}; - if (!actualTreatAsContiguous && dummyNeedsContiguity) { - setCopyIn(); - // Cannot do copy-out for vector subscripts: there could be repeated - // indices, for example - if (!actualHasVectorSubscript) { - setCopyOut(); - } - return {mayNeedCopyIn, mayNeedCopyOut}; - } - - 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.) - auto actualType{characteristics::TypeAndShape::Characterize(actual, fc)}; - bool actualIsPolymorphic{actualType && actualType->type().IsPolymorphic()}; - if (actualIsPolymorphic && !dummyIsPolymorphic) { - setCopyIn(); - setCopyOut(); - } - } - - return {mayNeedCopyIn, mayNeedCopyOut}; -} - // Copy-in determination for implicit interface static bool MayNeedCopyIn(const ActualArgument &actual, FoldingContext &fc) { if (!evaluate::IsVariable(actual)) { diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index dd97bb4d96978..67892d368b6b5 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1251,8 +1251,10 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( if (callContext.doCopyIn) { Fortran::evaluate::FoldingContext &foldingContext{ callContext.converter.getFoldingContext()}; - auto [suggestCopyIn, suggestCopyOut] = Fortran::evaluate::MayNeedCopyInOut( - arg.entity, arg.characteristics, foldingContext); + bool suggestCopyIn = Fortran::evaluate::MayNeedCopy( + arg.entity, arg.characteristics, foldingContext, /*forCopyOut=*/false); + bool suggestCopyOut = Fortran::evaluate::MayNeedCopy( + arg.entity, arg.characteristics, foldingContext, /*forCopyOut=*/true); mustDoCopyIn = actual.isArray() && suggestCopyIn; mustDoCopyOut = mustDoCopyIn && suggestCopyOut; } From fce3da47a97dbd2f5d342eaec91016f41855a267 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Wed, 20 Aug 2025 20:05:19 -0400 Subject: [PATCH 61/79] Simplified MayNeedCopyOut() --- flang/lib/Evaluate/check-expression.cpp | 58 ++++++++++--------------- 1 file changed, 23 insertions(+), 35 deletions(-) diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index 03ec8c8969903..897717064b20e 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1447,7 +1447,7 @@ std::optional CheckStatementFunction( } // Copy-in determination for implicit interface -static bool MayNeedCopyIn(const ActualArgument &actual, FoldingContext &fc) { +static bool MayNeedCopyIn(FoldingContext &fc, const ActualArgument &actual) { if (!evaluate::IsVariable(actual)) { // Actual argument expressions that aren’t variables are copy-in, but // not copy-out. @@ -1461,24 +1461,9 @@ static bool MayNeedCopyIn(const ActualArgument &actual, FoldingContext &fc) { return false; } -// Copy-out determination for implicit interface -static bool MayNeedCopyOut(const ActualArgument &actual, FoldingContext &fc) { - if (!evaluate::IsVariable(actual)) { - // Expressions are never copy-out - return false; - } - if (HasVectorSubscript(actual)) { - // Vector subscripts could refer to duplicate elements, can't copy out - return false; - } - // For all other cases may need to copy-out. The final determination of - // whether to copy-out should be made together witih copy-in. - return true; -} - // Copy-in determination for explicit interface -static bool MayNeedCopyIn(const ActualArgument &actual, - const characteristics::DummyDataObject &dummyObj, FoldingContext &fc) { +static bool MayNeedCopyIn(FoldingContext &fc, const ActualArgument &actual, + const characteristics::DummyDataObject &dummyObj) { if (dummyObj.intent == common::Intent::Out) { // INTENT(OUT) dummy args never need copy-in return false; @@ -1543,17 +1528,23 @@ static bool MayNeedCopyIn(const ActualArgument &actual, return false; } -// Copy-out determination for explicit interface -static bool MayNeedCopyOut(const ActualArgument &actual, - const characteristics::DummyDataObject &dummyObj, FoldingContext &fc) { - if (dummyObj.intent == common::Intent::In) { - // INTENT(IN) dummy args never need copy-out - return false; - } - if (dummyObj.attrs.test(characteristics::DummyDataObject::Attr::Value)) { - // Pass by value, never copy-out - return false; +// Copy-out determination for both implicit and explicit interfaces +static bool MayNeedCopyOut(FoldingContext &fc, const ActualArgument &actual, + const characteristics::DummyDataObject *dummyObj = nullptr) { + if (dummyObj) { // Explict interface + if (dummyObj->intent == common::Intent::In) { + // INTENT(IN) dummy args never need copy-out + return false; + } + if (dummyObj->attrs.test(characteristics::DummyDataObject::Attr::Value)) { + // Pass by value, never copy-out + return false; + } + if (ExtractCoarrayRef(actual) && dummyObj->type.corank() > 0) { + return false; + } } + // Both implict and explict interface if (!evaluate::IsVariable(actual)) { // Expressions are never copy-out return false; @@ -1562,9 +1553,6 @@ static bool MayNeedCopyOut(const ActualArgument &actual, // Vector subscripts could refer to duplicate elements, can't copy out return false; } - if (ExtractCoarrayRef(actual) && dummyObj.type.corank() > 0) { - return false; - } // For all other cases may need to copy-out. The final determination of // whether to copy-out should be made together witih copy-in. return true; @@ -1594,9 +1582,9 @@ bool MayNeedCopy(const ActualArgument *actual, return true; } if (forCopyOut) { - return MayNeedCopyOut(*actual, fc); + return MayNeedCopyOut(fc, *actual); } else { - return MayNeedCopyIn(*actual, fc); + return MayNeedCopyIn(fc, *actual); } } else { // Explicit interface const auto *dummyObj{ @@ -1606,9 +1594,9 @@ bool MayNeedCopy(const ActualArgument *actual, return false; } if (forCopyOut) { - return MayNeedCopyOut(*actual, *dummyObj, fc); + return MayNeedCopyOut(fc, *actual, dummyObj); } else { - return MayNeedCopyIn(*actual, *dummyObj, fc); + return MayNeedCopyIn(fc, *actual, *dummyObj); } } } From e36a534ebaaf0829bb212f53e20c86e30c8d3332 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Wed, 20 Aug 2025 20:12:55 -0400 Subject: [PATCH 62/79] Enhanced flang/test/Lower/force-temp.f90 to cover more cases --- flang/test/Lower/force-temp.f90 | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/flang/test/Lower/force-temp.f90 b/flang/test/Lower/force-temp.f90 index 1cfa218cfe7ab..11f37ae69390a 100644 --- a/flang/test/Lower/force-temp.f90 +++ b/flang/test/Lower/force-temp.f90 @@ -7,11 +7,21 @@ subroutine pass_ignore_tkr(buf) !DIR$ IGNORE_TKR buf real :: buf end subroutine + subroutine pass_ignore_tkr_2(buf) + implicit none + !DIR$ IGNORE_TKR(tkrdm) buf + type(*) :: buf + end subroutine subroutine pass_ignore_tkr_c(buf) implicit none !DIR$ IGNORE_TKR (tkrc) buf real :: buf end subroutine + subroutine pass_ignore_tkr_c_2(buf) + implicit none + !DIR$ IGNORE_TKR (tkrcdm) buf + type(*) :: buf + end subroutine end interface contains subroutine s1(buf) @@ -32,4 +42,22 @@ subroutine s2(buf) ! Don't create temp here call pass_ignore_tkr_c(buf) end subroutine + subroutine s3(buf) +!CHECK-LABEL: func.func @_QMtestPs3 +!CHECK: hlfir.copy_in +!CHECK: fir.call @_QPpass_ignore_tkr_2 +!CHECK: hlfir.copy_out + real, intent(inout) :: buf(:) + ! Create temp here + call pass_ignore_tkr_2(buf) + end subroutine + subroutine s4(buf) +!CHECK-LABEL: func.func @_QMtestPs4 +!CHECK-NOT: hlfir.copy_in +!CHECK: fir.call @_QPpass_ignore_tkr_c_2 +!CHECK-NOT: hlfir.copy_out + real, intent(inout) :: buf(:) + ! Don't create temp here + call pass_ignore_tkr_c_2(buf) + end subroutine end module From 73e9db7329b696fd7ef869466d8512cf7925c58c Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Tue, 19 Aug 2025 21:49:06 -0400 Subject: [PATCH 63/79] WIP: new API MayNeedCopy() --- flang/include/flang/Evaluate/call.h | 1 + .../include/flang/Evaluate/characteristics.h | 1 + .../include/flang/Evaluate/check-expression.h | 3 + flang/lib/Evaluate/call.cpp | 4 + flang/lib/Evaluate/characteristics.cpp | 5 + flang/lib/Evaluate/check-expression.cpp | 92 +++++++++++++++++++ 6 files changed, 106 insertions(+) diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h index 2a5929b873d74..8f2abf72a1183 100644 --- a/flang/include/flang/Evaluate/call.h +++ b/flang/include/flang/Evaluate/call.h @@ -110,6 +110,7 @@ class ActualArgument { std::optional GetType() const; int Rank() const; + bool IsArray() const ; bool operator==(const ActualArgument &) const; llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const; diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h index b6a9ebefec9df..ab0316c00dc76 100644 --- a/flang/include/flang/Evaluate/characteristics.h +++ b/flang/include/flang/Evaluate/characteristics.h @@ -254,6 +254,7 @@ struct DummyDataObject { bool CanBePassedViaImplicitInterface(std::string *whyNot = nullptr) const; bool IsPassedByDescriptor(bool isBindC) const; llvm::raw_ostream &Dump(llvm::raw_ostream &) const; + bool IsArray() const; TypeAndShape type; std::vector> coshape; diff --git a/flang/include/flang/Evaluate/check-expression.h b/flang/include/flang/Evaluate/check-expression.h index ac1e1549a99fb..517f0fc4b02bc 100644 --- a/flang/include/flang/Evaluate/check-expression.h +++ b/flang/include/flang/Evaluate/check-expression.h @@ -163,6 +163,9 @@ extern template bool IsErrorExpr(const Expr &); std::optional CheckStatementFunction( const Symbol &, const Expr &, FoldingContext &); +bool MayNeedCopy(const ActualArgument *, const characteristics::DummyArgument *, + FoldingContext &, bool); + // Returns a pair of Booleans. The first boolean specifies whether given actual // argument may need copy-in operation and the second Boolean specifies whether // copy-out may be necessary. This function works with implicit interface diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index f77df92a7597a..9648b2f2d91b2 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -56,6 +56,10 @@ int ActualArgument::Rank() const { } } +bool ActualArgument::IsArray() const { + return semantics::IsAssumedRank(*this) || Rank() > 0; +} + bool ActualArgument::operator==(const ActualArgument &that) const { return keyword_ == that.keyword_ && attrs_ == that.attrs_ && u_ == that.u_; } diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp index 37c62c93a87df..9753b367510e2 100644 --- a/flang/lib/Evaluate/characteristics.cpp +++ b/flang/lib/Evaluate/characteristics.cpp @@ -530,6 +530,11 @@ bool DummyDataObject::IsPassedByDescriptor(bool isBindC) const { return false; } +bool DummyDataObject::IsArray() const { + return type.attrs().test(characteristics::TypeAndShape::Attr::AssumedRank) || + type.Rank() > 0; +} + llvm::raw_ostream &DummyDataObject::Dump(llvm::raw_ostream &o) const { attrs.Dump(o, EnumToString); if (intent != common::Intent::Default) { diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index 2b4123c831878..379f97afd3ee6 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1575,4 +1575,96 @@ std::pair MayNeedCopyInOut(const ActualArgument &actual, return {mayNeedCopyIn, mayNeedCopyOut}; } +// Copy-in determination for implicit interface +static bool MayNeedCopyIn(const ActualArgument& actual, FoldingContext& fc) { + if (!evaluate::IsVariable(actual)) { + // Actual argument expressions that aren’t variables are copy-in, but + // not copy-out. + return true; + } + if (actual.IsArray() && !IsSimplyContiguous(actual, fc)) { + // Actual arguments that are variables are copy-in when non-contiguous. + return true; + } + return false; +} + +// Copy-out determination for implicit interface +static bool MayNeedCopyOut(const ActualArgument& actual, FoldingContext& fc) { + if (actual.IsArray() && evaluate::IsVariable(actual) && + !IsSimplyContiguous(actual, fc) && !HasVectorSubscript(actual)) { + // Actual arguments that are non-contiguous array variables are copy-out + // when don't have vector subscripts + return true; + } + return false; +} + +// Copy-in determination for explicit interface +static bool MayNeedCopyIn(const ActualArgument& actual, + const characteristics::DummyDataObject &dummyObj, + FoldingContext& fc) { + if (dummyObj.intent == common::Intent::Out) { + // INTENT(OUT) dummy args never need copy-in + return false; + } + if (dummyObj.attrs.test(characteristics::DummyDataObject::Attr::Value)) { + // Pass by value, always copy-in, never copy-out + return true; + } + + return false; +} + +// Copy-out determination for explicit interface +static bool MayNeedCopyOut(const ActualArgument& actual, + const characteristics::DummyDataObject &dummyObj, + FoldingContext& fc) { + if (dummyObj.intent == common::Intent::Out) { + // INTENT(IN) dummy args never need copy-out + return false; + } + return false; +} + +// TODO: dummy is coarray: dummy.type.corank() > 0 + +// 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. +bool MayNeedCopy(const ActualArgument *actual, + const characteristics::DummyArgument *dummy, + FoldingContext &fc, bool forCopyOut) { + if (!actual) { + return false; + } + if (actual->isAlternateReturn()) { + return false; + } + if (!dummy) { // Implicit interface + if (ExtractCoarrayRef(actual)) { + // Coindexed actual args need copy-in and copy-out + return true; + } + if (forCopyOut) { + return MayNeedCopyOut(*actual, fc); + } else { + return MayNeedCopyIn(*actual, fc); + } + } else { // Explicit interface + const auto *dummyObj{std::get_if(&dummy->u)}; + if (!dummyObj) { + // Only DummyDataObject has the information we need + return false; + } + if (forCopyOut) { + return MayNeedCopyOut(*actual, *dummyObj, fc); + } else { + return MayNeedCopyIn(*actual, *dummyObj, fc); + } + } +} + } // namespace Fortran::evaluate From 3baa7dad6caf878618d44b9573afd0af475d786a Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Wed, 20 Aug 2025 20:24:36 -0400 Subject: [PATCH 64/79] Fixed bad merge --- flang/lib/Evaluate/check-expression.cpp | 92 ------------------------- 1 file changed, 92 deletions(-) diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index e1ad38e0eb074..897717064b20e 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1601,96 +1601,4 @@ bool MayNeedCopy(const ActualArgument *actual, } } -// Copy-in determination for implicit interface -static bool MayNeedCopyIn(const ActualArgument& actual, FoldingContext& fc) { - if (!evaluate::IsVariable(actual)) { - // Actual argument expressions that aren’t variables are copy-in, but - // not copy-out. - return true; - } - if (actual.IsArray() && !IsSimplyContiguous(actual, fc)) { - // Actual arguments that are variables are copy-in when non-contiguous. - return true; - } - return false; -} - -// Copy-out determination for implicit interface -static bool MayNeedCopyOut(const ActualArgument& actual, FoldingContext& fc) { - if (actual.IsArray() && evaluate::IsVariable(actual) && - !IsSimplyContiguous(actual, fc) && !HasVectorSubscript(actual)) { - // Actual arguments that are non-contiguous array variables are copy-out - // when don't have vector subscripts - return true; - } - return false; -} - -// Copy-in determination for explicit interface -static bool MayNeedCopyIn(const ActualArgument& actual, - const characteristics::DummyDataObject &dummyObj, - FoldingContext& fc) { - if (dummyObj.intent == common::Intent::Out) { - // INTENT(OUT) dummy args never need copy-in - return false; - } - if (dummyObj.attrs.test(characteristics::DummyDataObject::Attr::Value)) { - // Pass by value, always copy-in, never copy-out - return true; - } - - return false; -} - -// Copy-out determination for explicit interface -static bool MayNeedCopyOut(const ActualArgument& actual, - const characteristics::DummyDataObject &dummyObj, - FoldingContext& fc) { - if (dummyObj.intent == common::Intent::Out) { - // INTENT(IN) dummy args never need copy-out - return false; - } - return false; -} - -// TODO: dummy is coarray: dummy.type.corank() > 0 - -// 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. -bool MayNeedCopy(const ActualArgument *actual, - const characteristics::DummyArgument *dummy, - FoldingContext &fc, bool forCopyOut) { - if (!actual) { - return false; - } - if (actual->isAlternateReturn()) { - return false; - } - if (!dummy) { // Implicit interface - if (ExtractCoarrayRef(actual)) { - // Coindexed actual args need copy-in and copy-out - return true; - } - if (forCopyOut) { - return MayNeedCopyOut(*actual, fc); - } else { - return MayNeedCopyIn(*actual, fc); - } - } else { // Explicit interface - const auto *dummyObj{std::get_if(&dummy->u)}; - if (!dummyObj) { - // Only DummyDataObject has the information we need - return false; - } - if (forCopyOut) { - return MayNeedCopyOut(*actual, *dummyObj, fc); - } else { - return MayNeedCopyIn(*actual, *dummyObj, fc); - } - } -} - } // namespace Fortran::evaluate From 3e281e49b20a06d233ad74f8ca3bdebaab2a458d Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Thu, 21 Aug 2025 22:17:22 -0400 Subject: [PATCH 65/79] Yet another refactoring and logic update: use common class CopyInOutExplicitInterface. Reduce the number of helper functions to two, one for copy-in and one for copy-out --- flang/lib/Evaluate/check-expression.cpp | 272 ++++++++++++++---------- 1 file changed, 162 insertions(+), 110 deletions(-) diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index 897717064b20e..c64c5e9cc5264 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1446,116 +1446,183 @@ std::optional CheckStatementFunction( return StmtFunctionChecker{sf, context}(expr); } -// Copy-in determination for implicit interface -static bool MayNeedCopyIn(FoldingContext &fc, const ActualArgument &actual) { - if (!evaluate::IsVariable(actual)) { - // Actual argument expressions that aren’t variables are copy-in, but - // not copy-out. - return true; - } - if (!IsSimplyContiguous(actual, fc)) { - // Actual arguments that are variables are copy-in when non-contiguous. - return true; +// Helper class for cheching 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)}; + if (!actualTreatAsContiguous && dummyNeedsContiguity) { + return true; + } + return false; } - // For everything else assume no copy-in - return false; -} -// Copy-in determination for explicit interface -static bool MayNeedCopyIn(FoldingContext &fc, const ActualArgument &actual, - const characteristics::DummyDataObject &dummyObj) { - if (dummyObj.intent == common::Intent::Out) { - // INTENT(OUT) dummy args never need copy-in + // 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; } - if (dummyObj.attrs.test(characteristics::DummyDataObject::Attr::Value)) { - // Pass by value, always copy-in, never copy-out - return true; + + bool HaveArrayArgs() const { + bool dummyTreatAsArray{dummyObj_.ignoreTKR.test(common::IgnoreTKR::Rank)}; + return actual_.IsArray() && (dummyObj_.IsArray() || dummyTreatAsArray); } - // Note: checks below deal with array arguments - bool dummyTreatAsArray{dummyObj.ignoreTKR.test(common::IgnoreTKR::Rank)}; - if (!actual.IsArray() || !(dummyObj.IsArray() || dummyTreatAsArray)) { - return false; + + bool PassByValue() const { + return dummyObj_.attrs.test(characteristics::DummyDataObject::Attr::Value); + } + + bool HaveCoarrayDifferences() const { + return ExtractCoarrayRef(actual_) && dummyObj_.type.corank() == 0; } - // Check actual contiguity, unless dummy doesn't care - 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)}; - if (!actualTreatAsContiguous && dummyNeedsContiguity) { + + bool HasIntentOut() const { + return dummyObj_.intent == common::Intent::Out; + } + + bool HasIntentIn() const { + return dummyObj_.intent == common::Intent::In; + } + +private: + FoldingContext &fc_; + const ActualArgument &actual_; + const characteristics::DummyDataObject &dummyObj_; +}; + +static bool MayNeedCopyIn(FoldingContext &fc, const ActualArgument &actual, + const characteristics::DummyDataObject *dummyObj) { + if (!evaluate::IsVariable(actual)) { + // Actual argument expressions that aren’t variables are copy-in, but + // not copy-out. return true; } - 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.) - auto actualType{characteristics::TypeAndShape::Characterize(actual, fc)}; - bool actualIsPolymorphic{actualType && actualType->type().IsPolymorphic()}; - if (actualIsPolymorphic && !dummyIsPolymorphic) { + if (dummyObj) { // Explicit interface + CopyInOutExplicitInterface check{fc, actual, *dummyObj}; + if (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 true; + } + if (check.HaveCoarrayDifferences()) { + return true; + } + // Note: contiguity and polymorphic checks deal with array arguments + if (!check.HaveArrayArgs()) { + 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)) { + // Actual arguments that are variables are copy-in when non-contiguous. return true; } - } - if (ExtractCoarrayRef(actual) && dummyObj.type.corank() == 0) { - // Actual is a corray variable, dummy is not, should copy-in - return true; } // For everything else assume no copy-in return false; } -// Copy-out determination for both implicit and explicit interfaces static bool MayNeedCopyOut(FoldingContext &fc, const ActualArgument &actual, - const characteristics::DummyDataObject *dummyObj = nullptr) { + const characteristics::DummyDataObject *dummyObj) { + if (!evaluate::IsVariable(actual)) { + // Expressions are never copy-out + return false; + } if (dummyObj) { // Explict interface - if (dummyObj->intent == common::Intent::In) { + CopyInOutExplicitInterface check{fc, actual, *dummyObj}; + if (check.HasIntentIn()) { // INTENT(IN) dummy args never need copy-out return false; } - if (dummyObj->attrs.test(characteristics::DummyDataObject::Attr::Value)) { - // Pass by value, never copy-out + if (check.PassByValue()) { + // Pass by value is never copy-out return false; } - if (ExtractCoarrayRef(actual) && dummyObj->type.corank() > 0) { + if (check.HaveCoarrayDifferences()) { + return true; + } + // Note: contiguity and polymorphic checks deal with array arguments + if (!check.HaveArrayArgs()) { 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)) { + // Vector subscripts could refer to duplicate elements, can't copy out + return !HasVectorSubscript(actual); + } } - // Both implict and explict interface - if (!evaluate::IsVariable(actual)) { - // Expressions are never copy-out - return false; - } - if (HasVectorSubscript(actual)) { - // Vector subscripts could refer to duplicate elements, can't copy out - return false; - } - // For all other cases may need to copy-out. The final determination of - // whether to copy-out should be made together witih copy-in. - return true; + // For everything else assume no copy-out + return false; } // If forCopyOut is false, returns if a particular actual/dummy argument @@ -1564,8 +1631,10 @@ static bool MayNeedCopyOut(FoldingContext &fc, const ActualArgument &actual, // procedures with explicit interface, it's expected that "dummy" is not null. // For procedures with implicit interface dummy may be null. // -// Note that ultimate decisions about whether copy-out is necessary may -// depend on whether copy-in was necessary. +// 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) { @@ -1575,29 +1644,12 @@ bool MayNeedCopy(const ActualArgument *actual, if (actual->isAlternateReturn()) { return false; } - if (!dummy) { // Implicit interface - if (ExtractCoarrayRef(actual)) { - // Coindexed actual args may need copy-in and copy-out with implicit - // interface - return true; - } - if (forCopyOut) { - return MayNeedCopyOut(fc, *actual); - } else { - return MayNeedCopyIn(fc, *actual); - } - } else { // Explicit interface - const auto *dummyObj{ - std::get_if(&dummy->u)}; - if (!dummyObj) { - // Only DummyDataObject has the information we need - return false; - } - if (forCopyOut) { - return MayNeedCopyOut(fc, *actual, dummyObj); - } else { - return MayNeedCopyIn(fc, *actual, *dummyObj); - } + const auto *dummyObj{ + dummy ? std::get_if(&dummy->u) : nullptr}; + if (forCopyOut) { + return MayNeedCopyOut(fc, *actual, dummyObj); + } else { + return MayNeedCopyIn(fc, *actual, dummyObj); } } From b8e78b15798f036838b6dfba04d48864f588ae34 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Fri, 22 Aug 2025 11:55:05 -0400 Subject: [PATCH 66/79] clang-format --- flang/lib/Evaluate/check-expression.cpp | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index c64c5e9cc5264..dbf70a2f5b110 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1475,7 +1475,8 @@ class CopyInOutExplicitInterface { // Explicit shape and assumed size arrays must be contiguous bool dummyNeedsContiguity{dummyIsExplicitShape || dummyIsAssumedSize || (dummyTreatAsArray && !dummyIsPolymorphic) || dummyIsVoidStar || - dummyObj_.attrs.test(characteristics::DummyDataObject::Attr::Contiguous)}; + dummyObj_.attrs.test( + characteristics::DummyDataObject::Attr::Contiguous)}; if (!actualTreatAsContiguous && dummyNeedsContiguity) { return true; } @@ -1498,10 +1499,13 @@ class CopyInOutExplicitInterface { // 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.) + // 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()}; + auto actualType{ + characteristics::TypeAndShape::Characterize(actual_, fc_)}; + bool actualIsPolymorphic{ + actualType && actualType->type().IsPolymorphic()}; if (actualIsPolymorphic && !dummyIsPolymorphic) { return true; } @@ -1522,13 +1526,9 @@ class CopyInOutExplicitInterface { return ExtractCoarrayRef(actual_) && dummyObj_.type.corank() == 0; } - bool HasIntentOut() const { - return dummyObj_.intent == common::Intent::Out; - } + bool HasIntentOut() const { return dummyObj_.intent == common::Intent::Out; } - bool HasIntentIn() const { - return dummyObj_.intent == common::Intent::In; - } + bool HasIntentIn() const { return dummyObj_.intent == common::Intent::In; } private: FoldingContext &fc_; @@ -1644,8 +1644,9 @@ bool MayNeedCopy(const ActualArgument *actual, if (actual->isAlternateReturn()) { return false; } - const auto *dummyObj{ - dummy ? std::get_if(&dummy->u) : nullptr}; + const auto *dummyObj{dummy + ? std::get_if(&dummy->u) + : nullptr}; if (forCopyOut) { return MayNeedCopyOut(fc, *actual, dummyObj); } else { From 629b67d5d55a2ded66ea8a0ad0973a3931564476 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Fri, 22 Aug 2025 14:28:14 -0400 Subject: [PATCH 67/79] debugging (checking the old code again) --- flang/lib/Lower/ConvertCall.cpp | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index 67892d368b6b5..e1a5a1d2d5fbf 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1184,6 +1184,19 @@ static bool isParameterObjectOrSubObject(hlfir::Entity entity) { return foundParameter; } + +static bool +isSimplyContiguous(const Fortran::evaluate::ActualArgument &arg, + Fortran::evaluate::FoldingContext &foldingContext) { + if (const auto *expr = arg.UnwrapExpr()) + return Fortran::evaluate::IsSimplyContiguous(*expr, foldingContext); + const Fortran::semantics::Symbol *sym = arg.GetAssumedTypeDummy(); + assert(sym && + "expect ActualArguments to be expression or assumed-type symbols"); + return sym->Rank() == 0 || + Fortran::evaluate::IsSimplyContiguous(*sym, foldingContext); +} + /// When dummy is not ALLOCATABLE, POINTER and is not passed in register, /// prepare the actual argument according to the interface. Do as needed: /// - address element if this is an array argument in an elemental call. @@ -1249,6 +1262,14 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( bool mustDoCopyOut{false}; if (callContext.doCopyIn) { + + // DEBUG: old code + const bool oldMustDoCopyInOut = + actual.isArray() && arg.mustBeMadeContiguous() && + (passingPolymorphicToNonPolymorphic || + !isSimplyContiguous(*arg.entity, foldingContext)); + const bool oldMustDoCopyOut = arg.mayBeModifiedByCall(); + Fortran::evaluate::FoldingContext &foldingContext{ callContext.converter.getFoldingContext()}; bool suggestCopyIn = Fortran::evaluate::MayNeedCopy( @@ -1257,6 +1278,12 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( arg.entity, arg.characteristics, foldingContext, /*forCopyOut=*/true); mustDoCopyIn = actual.isArray() && suggestCopyIn; mustDoCopyOut = mustDoCopyIn && suggestCopyOut; + + // DEBUG: + llvm::dbgs() << "copyinout: oldMustDoCopyInOut = " << oldMustDoCopyInOut + << ", mustDoCopyIn = " << mustDoCopyIn + << "| oldMustDoCopyOut = " << oldMustDoCopyOut + << ", mustDoCopyOut " << mustDoCopyOut << "\n"; } const bool actualIsAssumedRank = actual.isAssumedRank(); From 6138cc8d92cfa72eff0223389527f58634de425e Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Fri, 22 Aug 2025 16:12:28 -0400 Subject: [PATCH 68/79] Fixed build issue with the old code --- flang/lib/Lower/ConvertCall.cpp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index e1a5a1d2d5fbf..ca66a766bbd03 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1262,6 +1262,8 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( bool mustDoCopyOut{false}; if (callContext.doCopyIn) { + Fortran::evaluate::FoldingContext &foldingContext{ + callContext.converter.getFoldingContext()}; // DEBUG: old code const bool oldMustDoCopyInOut = @@ -1270,8 +1272,6 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( !isSimplyContiguous(*arg.entity, foldingContext)); const bool oldMustDoCopyOut = arg.mayBeModifiedByCall(); - Fortran::evaluate::FoldingContext &foldingContext{ - callContext.converter.getFoldingContext()}; bool suggestCopyIn = Fortran::evaluate::MayNeedCopy( arg.entity, arg.characteristics, foldingContext, /*forCopyOut=*/false); bool suggestCopyOut = Fortran::evaluate::MayNeedCopy( From 02eec4c15024c3995c43b0a66e47e4c0819dc54f Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Fri, 22 Aug 2025 18:51:10 -0400 Subject: [PATCH 69/79] Different copy-in/copy-out flag configuration --- flang/lib/Lower/ConvertCall.cpp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index ca66a766bbd03..72bb0151607c9 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1277,7 +1277,7 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( bool suggestCopyOut = Fortran::evaluate::MayNeedCopy( arg.entity, arg.characteristics, foldingContext, /*forCopyOut=*/true); mustDoCopyIn = actual.isArray() && suggestCopyIn; - mustDoCopyOut = mustDoCopyIn && suggestCopyOut; + mustDoCopyOut = actual.isArray() && suggestCopyOut; // DEBUG: llvm::dbgs() << "copyinout: oldMustDoCopyInOut = " << oldMustDoCopyInOut @@ -1394,7 +1394,7 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( entity = hlfir::Entity{associate.getBase()}; // Register the temporary destruction after the call. preparedDummy.pushExprAssociateCleanUp(associate); - } else if (mustDoCopyIn) { + } else if (mustDoCopyIn || mustDoCopyOut) { // Copy-in non contiguous variables. // TODO: for non-finalizable monomorphic derived type actual // arguments associated with INTENT(OUT) dummy arguments From 5ddac27434b65d67241c297819992400ced60e32 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Sun, 24 Aug 2025 21:54:58 -0400 Subject: [PATCH 70/79] Removed the old code --- flang/lib/Lower/ConvertCall.cpp | 26 -------------------------- 1 file changed, 26 deletions(-) diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index 72bb0151607c9..bd5cdbfb4f4bb 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1184,19 +1184,6 @@ static bool isParameterObjectOrSubObject(hlfir::Entity entity) { return foundParameter; } - -static bool -isSimplyContiguous(const Fortran::evaluate::ActualArgument &arg, - Fortran::evaluate::FoldingContext &foldingContext) { - if (const auto *expr = arg.UnwrapExpr()) - return Fortran::evaluate::IsSimplyContiguous(*expr, foldingContext); - const Fortran::semantics::Symbol *sym = arg.GetAssumedTypeDummy(); - assert(sym && - "expect ActualArguments to be expression or assumed-type symbols"); - return sym->Rank() == 0 || - Fortran::evaluate::IsSimplyContiguous(*sym, foldingContext); -} - /// When dummy is not ALLOCATABLE, POINTER and is not passed in register, /// prepare the actual argument according to the interface. Do as needed: /// - address element if this is an array argument in an elemental call. @@ -1265,25 +1252,12 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( Fortran::evaluate::FoldingContext &foldingContext{ callContext.converter.getFoldingContext()}; - // DEBUG: old code - const bool oldMustDoCopyInOut = - actual.isArray() && arg.mustBeMadeContiguous() && - (passingPolymorphicToNonPolymorphic || - !isSimplyContiguous(*arg.entity, foldingContext)); - const bool oldMustDoCopyOut = arg.mayBeModifiedByCall(); - bool suggestCopyIn = Fortran::evaluate::MayNeedCopy( arg.entity, arg.characteristics, foldingContext, /*forCopyOut=*/false); bool suggestCopyOut = Fortran::evaluate::MayNeedCopy( arg.entity, arg.characteristics, foldingContext, /*forCopyOut=*/true); mustDoCopyIn = actual.isArray() && suggestCopyIn; mustDoCopyOut = actual.isArray() && suggestCopyOut; - - // DEBUG: - llvm::dbgs() << "copyinout: oldMustDoCopyInOut = " << oldMustDoCopyInOut - << ", mustDoCopyIn = " << mustDoCopyIn - << "| oldMustDoCopyOut = " << oldMustDoCopyOut - << ", mustDoCopyOut " << mustDoCopyOut << "\n"; } const bool actualIsAssumedRank = actual.isAssumedRank(); From b5ff58148425bae15d332f62e7df1a175ab8ea6b Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Mon, 25 Aug 2025 08:10:53 -0400 Subject: [PATCH 71/79] updated comment --- flang/lib/Lower/ConvertCall.cpp | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index bd5cdbfb4f4bb..04dcc9250be61 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1370,6 +1370,12 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( preparedDummy.pushExprAssociateCleanUp(associate); } else if (mustDoCopyIn || mustDoCopyOut) { // Copy-in non contiguous variables. + // + // TODO: copy-in and copy-out are now determined separately, in order + // to allow more fine grained copying. While currently both copy-in + // and copy-out are must be done together, these copy operations could + // be separated in the future. (This is related to TODO comment below.) + // // TODO: for non-finalizable monomorphic derived type actual // arguments associated with INTENT(OUT) dummy arguments // we may avoid doing the copy and only allocate the temporary. From e54a8d278e15ea93c0906e427300e1462e9409f8 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Mon, 25 Aug 2025 17:12:48 -0400 Subject: [PATCH 72/79] Code review feedback --- flang/include/flang/Evaluate/call.h | 1 - .../include/flang/Evaluate/check-expression.h | 2 +- flang/lib/Evaluate/call.cpp | 4 --- flang/lib/Evaluate/check-expression.cpp | 31 ++++++++++++------- 4 files changed, 21 insertions(+), 17 deletions(-) diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h index 34266462a77c6..2a5929b873d74 100644 --- a/flang/include/flang/Evaluate/call.h +++ b/flang/include/flang/Evaluate/call.h @@ -110,7 +110,6 @@ class ActualArgument { std::optional GetType() const; int Rank() const; - bool IsArray() const; bool operator==(const ActualArgument &) const; llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const; diff --git a/flang/include/flang/Evaluate/check-expression.h b/flang/include/flang/Evaluate/check-expression.h index 57ffea2273fa4..2ff78d75325ef 100644 --- a/flang/include/flang/Evaluate/check-expression.h +++ b/flang/include/flang/Evaluate/check-expression.h @@ -164,7 +164,7 @@ std::optional CheckStatementFunction( const Symbol &, const Expr &, FoldingContext &); bool MayNeedCopy(const ActualArgument *, const characteristics::DummyArgument *, - FoldingContext &, bool); + FoldingContext &, bool forCopyOut); } // namespace Fortran::evaluate #endif diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp index 9648b2f2d91b2..f77df92a7597a 100644 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -56,10 +56,6 @@ int ActualArgument::Rank() const { } } -bool ActualArgument::IsArray() const { - return semantics::IsAssumedRank(*this) || Rank() > 0; -} - bool ActualArgument::operator==(const ActualArgument &that) const { return keyword_ == that.keyword_ && attrs_ == that.attrs_ && u_ == that.u_; } diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index dbf70a2f5b110..b31b790940241 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1446,7 +1446,7 @@ std::optional CheckStatementFunction( return StmtFunctionChecker{sf, context}(expr); } -// Helper class for cheching differences between actual and dummy arguments +// Helper class for checking differences between actual and dummy arguments class CopyInOutExplicitInterface { public: explicit CopyInOutExplicitInterface(FoldingContext &fc, @@ -1477,10 +1477,7 @@ class CopyInOutExplicitInterface { (dummyTreatAsArray && !dummyIsPolymorphic) || dummyIsVoidStar || dummyObj_.attrs.test( characteristics::DummyDataObject::Attr::Contiguous)}; - if (!actualTreatAsContiguous && dummyNeedsContiguity) { - return true; - } - return false; + return !actualTreatAsContiguous && dummyNeedsContiguity; } // Returns true, if actual and dummy have polymorphic differences @@ -1513,9 +1510,10 @@ class CopyInOutExplicitInterface { return false; } - bool HaveArrayArgs() const { + bool HaveArrayOrAssumedRankArgs() const { bool dummyTreatAsArray{dummyObj_.ignoreTKR.test(common::IgnoreTKR::Rank)}; - return actual_.IsArray() && (dummyObj_.IsArray() || dummyTreatAsArray); + return IsArrayOrAssumedRank(actual_) && + (IsArrayOrAssumedRank(dummyObj_) || dummyTreatAsArray); } bool PassByValue() const { @@ -1530,6 +1528,15 @@ class CopyInOutExplicitInterface { 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_; @@ -1556,8 +1563,9 @@ static bool MayNeedCopyIn(FoldingContext &fc, const ActualArgument &actual, if (check.HaveCoarrayDifferences()) { return true; } - // Note: contiguity and polymorphic checks deal with array arguments - if (!check.HaveArrayArgs()) { + // Note: contiguity and polymorphic checks deal with array or assumed rank + // arguments + if (!check.HaveArrayOrAssumedRankArgs()) { return false; } if (check.HaveContiguityDifferences()) { @@ -1600,8 +1608,9 @@ static bool MayNeedCopyOut(FoldingContext &fc, const ActualArgument &actual, if (check.HaveCoarrayDifferences()) { return true; } - // Note: contiguity and polymorphic checks deal with array arguments - if (!check.HaveArrayArgs()) { + // Note: contiguity and polymorphic checks deal with array or assumed rank + // arguments + if (!check.HaveArrayOrAssumedRankArgs()) { return false; } if (check.HaveContiguityDifferences()) { From d22d27c0e7de40e7698c46d8beba4bb5ccb31994 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Mon, 25 Aug 2025 17:13:11 -0400 Subject: [PATCH 73/79] clang-format --- flang/lib/Evaluate/check-expression.cpp | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index b31b790940241..0d15c0f630f69 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1532,9 +1532,11 @@ class CopyInOutExplicitInterface { 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; + static bool IsArrayOrAssumedRank( + const characteristics::DummyDataObject &dummy) { + return dummy.type.attrs().test( + characteristics::TypeAndShape::Attr::AssumedRank) || + dummy.type.Rank() > 0; } private: From 45eaddc4ec4542c093fb555f505729bf43fa15bd Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Mon, 25 Aug 2025 17:31:28 -0400 Subject: [PATCH 74/79] force-temp.f90: add test for INTENT(OUT) dummy argument --- flang/test/Lower/force-temp.f90 | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/flang/test/Lower/force-temp.f90 b/flang/test/Lower/force-temp.f90 index 11f37ae69390a..d9ba543d46313 100644 --- a/flang/test/Lower/force-temp.f90 +++ b/flang/test/Lower/force-temp.f90 @@ -22,6 +22,10 @@ subroutine pass_ignore_tkr_c_2(buf) !DIR$ IGNORE_TKR (tkrcdm) buf type(*) :: buf end subroutine + subroutine pass_intent_out(buf) + implicit none + integer, intent(out) :: buf(5) + end subroutine end interface contains subroutine s1(buf) @@ -60,4 +64,19 @@ subroutine s4(buf) ! Don't create temp here call pass_ignore_tkr_c_2(buf) end subroutine + subroutine s5() + ! TODO: pass_intent_out() has intent(out) dummy argument, so as such it + ! should have copy-out, but not copy-in. Unfortunately, at the moment flang + ! can only do copy-in/copy-out together. When this is fixed, this test should + ! change from 'CHECK' for hlfir.copy_in to 'CHECK-NOT' for hlfir.copy_in +!CHECK-LABEL: func.func @_QMtestPs5 +!CHECK: hlfir.copy_in +!CHECK: fir.call @_QPpass_intent_out +!CHECK: hlfir.copy_out + implicit none + integer, target :: x(10) + integer, pointer :: p(:) + p => x(::2) ! pointer to non-contiguous array section + call pass_intent_out(p) + end subroutine end module From fc283152fe8f95f270d1671dd7b0c86de47dcccb Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Mon, 25 Aug 2025 18:26:41 -0400 Subject: [PATCH 75/79] MayNeedCopy() simplification --- flang/lib/Evaluate/check-expression.cpp | 60 ++++++++++++++++++++++--- 1 file changed, 55 insertions(+), 5 deletions(-) diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index 0d15c0f630f69..80eed3e74d223 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1545,6 +1545,60 @@ class CopyInOutExplicitInterface { const characteristics::DummyDataObject &dummyObj_; }; +static bool MayNeedCopy(FoldingContext &fc, const ActualArgument &actual, + const characteristics::DummyDataObject *dummyObj, bool forCopyOut) { + 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) : true; + } + } + // For everything else, no copy-in or copy-out + return false; +} + static bool MayNeedCopyIn(FoldingContext &fc, const ActualArgument &actual, const characteristics::DummyDataObject *dummyObj) { if (!evaluate::IsVariable(actual)) { @@ -1658,11 +1712,7 @@ bool MayNeedCopy(const ActualArgument *actual, const auto *dummyObj{dummy ? std::get_if(&dummy->u) : nullptr}; - if (forCopyOut) { - return MayNeedCopyOut(fc, *actual, dummyObj); - } else { - return MayNeedCopyIn(fc, *actual, dummyObj); - } + return MayNeedCopy(fc, *actual, dummyObj, forCopyOut); } } // namespace Fortran::evaluate From c7a740ca54993155a2fae5a401580e5977d72957 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Mon, 25 Aug 2025 18:57:09 -0400 Subject: [PATCH 76/79] Further simplification of MayNeedCopy() --- flang/lib/Evaluate/check-expression.cpp | 51 ++++++++++++++++++++++++- 1 file changed, 50 insertions(+), 1 deletion(-) diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index 80eed3e74d223..a3594bde6b11f 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1712,7 +1712,56 @@ bool MayNeedCopy(const ActualArgument *actual, const auto *dummyObj{dummy ? std::get_if(&dummy->u) : nullptr}; - return MayNeedCopy(fc, *actual, dummyObj, forCopyOut); + 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) : true; + } + } + // For everything else, no copy-in or copy-out + return false; } } // namespace Fortran::evaluate From 0d9302e32d4f114102f8743cbf9493b2c1156082 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Mon, 25 Aug 2025 18:59:55 -0400 Subject: [PATCH 77/79] Removed the old code --- flang/lib/Evaluate/check-expression.cpp | 145 ------------------------ 1 file changed, 145 deletions(-) diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index a3594bde6b11f..bbd453822599f 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1545,151 +1545,6 @@ class CopyInOutExplicitInterface { const characteristics::DummyDataObject &dummyObj_; }; -static bool MayNeedCopy(FoldingContext &fc, const ActualArgument &actual, - const characteristics::DummyDataObject *dummyObj, bool forCopyOut) { - 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) : true; - } - } - // For everything else, no copy-in or copy-out - return false; -} - -static bool MayNeedCopyIn(FoldingContext &fc, const ActualArgument &actual, - const characteristics::DummyDataObject *dummyObj) { - if (!evaluate::IsVariable(actual)) { - // Actual argument expressions that aren’t variables are copy-in, but - // not copy-out. - return true; - } - if (dummyObj) { // Explicit interface - CopyInOutExplicitInterface check{fc, actual, *dummyObj}; - if (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 true; - } - 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)) { - // Actual arguments that are variables are copy-in when non-contiguous. - return true; - } - } - // For everything else assume no copy-in - return false; -} - -static bool MayNeedCopyOut(FoldingContext &fc, const ActualArgument &actual, - const characteristics::DummyDataObject *dummyObj) { - if (!evaluate::IsVariable(actual)) { - // Expressions are never copy-out - return false; - } - if (dummyObj) { // Explict interface - CopyInOutExplicitInterface check{fc, actual, *dummyObj}; - if (check.HasIntentIn()) { - // INTENT(IN) dummy args never need copy-out - return false; - } - if (check.PassByValue()) { - // Pass by value is never copy-out - return false; - } - 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)) { - // Vector subscripts could refer to duplicate elements, can't copy out - return !HasVectorSubscript(actual); - } - } - // For everything else assume no copy-out - return false; -} - // 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 From d22d76f054d02d46f4fc71105a6d0d2ba0a45922 Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Mon, 25 Aug 2025 21:34:43 -0400 Subject: [PATCH 78/79] Removed DummyDataObject::IsArray() (no longer used) --- flang/include/flang/Evaluate/characteristics.h | 1 - flang/lib/Evaluate/characteristics.cpp | 5 ----- 2 files changed, 6 deletions(-) diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h index ab0316c00dc76..b6a9ebefec9df 100644 --- a/flang/include/flang/Evaluate/characteristics.h +++ b/flang/include/flang/Evaluate/characteristics.h @@ -254,7 +254,6 @@ struct DummyDataObject { bool CanBePassedViaImplicitInterface(std::string *whyNot = nullptr) const; bool IsPassedByDescriptor(bool isBindC) const; llvm::raw_ostream &Dump(llvm::raw_ostream &) const; - bool IsArray() const; TypeAndShape type; std::vector> coshape; diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp index 9753b367510e2..37c62c93a87df 100644 --- a/flang/lib/Evaluate/characteristics.cpp +++ b/flang/lib/Evaluate/characteristics.cpp @@ -530,11 +530,6 @@ bool DummyDataObject::IsPassedByDescriptor(bool isBindC) const { return false; } -bool DummyDataObject::IsArray() const { - return type.attrs().test(characteristics::TypeAndShape::Attr::AssumedRank) || - type.Rank() > 0; -} - llvm::raw_ostream &DummyDataObject::Dump(llvm::raw_ostream &o) const { attrs.Dump(o, EnumToString); if (intent != common::Intent::Default) { From 3c64f1383b6057afebe9a6fb1f0918e4695ecf7f Mon Sep 17 00:00:00 2001 From: Eugene Epshteyn Date: Tue, 26 Aug 2025 14:39:28 -0400 Subject: [PATCH 79/79] Code review feedback --- flang/lib/Evaluate/check-expression.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index bbd453822599f..93153cc9bc12c 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -1612,7 +1612,7 @@ bool MayNeedCopy(const ActualArgument *actual, // non-contiguous. // Copy-out: vector subscripts could refer to duplicate elements, can't // copy out. - return forCopyOut ? !HasVectorSubscript(*actual) : true; + return !(forCopyOut && HasVectorSubscript(*actual)); } } // For everything else, no copy-in or copy-out