[flang-commits] [flang] 29d1a49 - [flang] Document and use intrinsic subroutine argument intents
Jean Perier via flang-commits
flang-commits at lists.llvm.org
Tue Oct 20 05:11:16 PDT 2020
Author: Jean Perier
Date: 2020-10-20T14:09:46+02:00
New Revision: 29d1a494477d78f9c86564b851891702456ddffb
URL: https://github.com/llvm/llvm-project/commit/29d1a494477d78f9c86564b851891702456ddffb
DIFF: https://github.com/llvm/llvm-project/commit/29d1a494477d78f9c86564b851891702456ddffb.diff
LOG: [flang] Document and use intrinsic subroutine argument intents
Check INTENT(OUT)/INTENT(INOUT) constraints for actual argument
of intrinsic procedure calls.
- Adding a common::Intent field to the IntrinsicDummyArgument
in the intrinsic table.
- Propagating it to the DummyDataObject intent field so that it can
later be used in CheckExplicitDataArg semantic checks.
- Add related tests.
- Fix regression (C846 false error), C846 INTENT(OUT) rule does
not apply to intrinsic call. Propagate the information that we
are in an intrinsic call up to CheckExplicitDataArg (that is
doing this check). Still enforce C846 on intrinsics other than MOVE_ALLOC (for which
allocatable coarrays are explicitly allowed) since it's not clear it is allowed in all
intrinsics and allowing this would lead to runtime penalties in the intrinsic runtime.
Differential Revision: https://reviews.llvm.org/D89473
Added:
Modified:
flang/include/flang/Evaluate/characteristics.h
flang/include/flang/Evaluate/intrinsics.h
flang/lib/Evaluate/characteristics.cpp
flang/lib/Evaluate/intrinsics.cpp
flang/lib/Semantics/check-call.cpp
flang/lib/Semantics/check-call.h
flang/lib/Semantics/expression.cpp
flang/test/Semantics/call03.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index a0e4cc5bedad..7ca8f9ad5d68 100644
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -233,6 +233,8 @@ struct DummyArgument {
std::string &&, const Expr<SomeType> &, FoldingContext &);
bool IsOptional() const;
void SetOptional(bool = true);
+ common::Intent GetIntent() const;
+ void SetIntent(common::Intent);
bool CanBePassedViaImplicitInterface() const;
bool IsTypelessIntrinsicDummy() const;
llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
diff --git a/flang/include/flang/Evaluate/intrinsics.h b/flang/include/flang/Evaluate/intrinsics.h
index 09f5691b1ea7..2cd9a3505588 100644
--- a/flang/include/flang/Evaluate/intrinsics.h
+++ b/flang/include/flang/Evaluate/intrinsics.h
@@ -102,5 +102,9 @@ class IntrinsicProcTable {
private:
Implementation *impl_{nullptr}; // owning pointer
};
+
+// Check if an intrinsic explicitly allows its INTENT(OUT) arguments to be
+// allocatable coarrays.
+bool AcceptsIntentOutAllocatableCoarray(const std::string &);
} // namespace Fortran::evaluate
#endif // FORTRAN_EVALUATE_INTRINSICS_H_
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index f42bde07b75b..3ebcfbcc8043 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -448,6 +448,26 @@ void DummyArgument::SetOptional(bool value) {
u);
}
+void DummyArgument::SetIntent(common::Intent intent) {
+ std::visit(common::visitors{
+ [intent](DummyDataObject &data) { data.intent = intent; },
+ [intent](DummyProcedure &proc) { proc.intent = intent; },
+ [](AlternateReturn &) { DIE("cannot set intent"); },
+ },
+ u);
+}
+
+common::Intent DummyArgument::GetIntent() const {
+ return std::visit(common::visitors{
+ [](const DummyDataObject &data) { return data.intent; },
+ [](const DummyProcedure &proc) { return proc.intent; },
+ [](const AlternateReturn &) -> common::Intent {
+ DIE("Alternate return have no intent");
+ },
+ },
+ u);
+}
+
bool DummyArgument::CanBePassedViaImplicitInterface() const {
if (const auto *object{std::get_if<DummyDataObject>(&u)}) {
return object->CanBePassedViaImplicitInterface();
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 2cbf8ef2725d..83fdc76c9bcd 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -198,6 +198,7 @@ struct IntrinsicDummyArgument {
TypePattern typePattern;
Rank rank{Rank::elemental};
Optionality optionality{Optionality::required};
+ common::Intent intent{common::Intent::In};
llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
};
@@ -935,68 +936,103 @@ static const SpecificIntrinsicInterface specificIntrinsicFunction[]{
};
static const IntrinsicInterface intrinsicSubroutine[]{
- {"cpu_time", {{"time", AnyReal, Rank::scalar}}, {}, Rank::elemental,
- IntrinsicClass::impureSubroutine},
+ {"cpu_time",
+ {{"time", AnyReal, Rank::scalar, Optionality::required,
+ common::Intent::Out}},
+ {}, Rank::elemental, IntrinsicClass::impureSubroutine},
{"date_and_time",
- {{"date", DefaultChar, Rank::scalar, Optionality::optional},
- {"time", DefaultChar, Rank::scalar, Optionality::optional},
- {"zone", DefaultChar, Rank::scalar, Optionality::optional},
- {"values", AnyInt, Rank::vector, Optionality::optional}},
+ {{"date", DefaultChar, Rank::scalar, Optionality::optional,
+ common::Intent::Out},
+ {"time", DefaultChar, Rank::scalar, Optionality::optional,
+ common::Intent::Out},
+ {"zone", DefaultChar, Rank::scalar, Optionality::optional,
+ common::Intent::Out},
+ {"values", AnyInt, Rank::vector, Optionality::optional,
+ common::Intent::Out}},
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
{"execute_command_line",
{{"command", DefaultChar, Rank::scalar},
{"wait", AnyLogical, Rank::scalar, Optionality::optional},
- {"exitstat", AnyInt, Rank::scalar, Optionality::optional},
- {"cmdstat", AnyInt, Rank::scalar, Optionality::optional},
- {"cmdmsg", DefaultChar, Rank::scalar, Optionality::optional}},
+ {"exitstat", AnyInt, Rank::scalar, Optionality::optional,
+ common::Intent::InOut},
+ {"cmdstat", AnyInt, Rank::scalar, Optionality::optional,
+ common::Intent::Out},
+ {"cmdmsg", DefaultChar, Rank::scalar, Optionality::optional,
+ common::Intent::InOut}},
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
{"get_command",
- {{"command", DefaultChar, Rank::scalar, Optionality::optional},
- {"length", AnyInt, Rank::scalar, Optionality::optional},
- {"status", AnyInt, Rank::scalar, Optionality::optional},
- {"errmsg", DefaultChar, Rank::scalar, Optionality::optional}},
+ {{"command", DefaultChar, Rank::scalar, Optionality::optional,
+ common::Intent::Out},
+ {"length", AnyInt, Rank::scalar, Optionality::optional,
+ common::Intent::Out},
+ {"status", AnyInt, Rank::scalar, Optionality::optional,
+ common::Intent::Out},
+ {"errmsg", DefaultChar, Rank::scalar, Optionality::optional,
+ common::Intent::InOut}},
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
{"get_command_argument",
{{"number", AnyInt, Rank::scalar},
- {"value", DefaultChar, Rank::scalar, Optionality::optional},
- {"length", AnyInt, Rank::scalar, Optionality::optional},
- {"status", AnyInt, Rank::scalar, Optionality::optional},
- {"errmsg", DefaultChar, Rank::scalar, Optionality::optional}},
+ {"value", DefaultChar, Rank::scalar, Optionality::optional,
+ common::Intent::Out},
+ {"length", AnyInt, Rank::scalar, Optionality::optional,
+ common::Intent::Out},
+ {"status", AnyInt, Rank::scalar, Optionality::optional,
+ common::Intent::Out},
+ {"errmsg", DefaultChar, Rank::scalar, Optionality::optional,
+ common::Intent::InOut}},
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
{"get_environment_variable",
{{"name", DefaultChar, Rank::scalar},
- {"value", DefaultChar, Rank::scalar, Optionality::optional},
- {"length", AnyInt, Rank::scalar, Optionality::optional},
- {"status", AnyInt, Rank::scalar, Optionality::optional},
+ {"value", DefaultChar, Rank::scalar, Optionality::optional,
+ common::Intent::Out},
+ {"length", AnyInt, Rank::scalar, Optionality::optional,
+ common::Intent::Out},
+ {"status", AnyInt, Rank::scalar, Optionality::optional,
+ common::Intent::Out},
{"trim_name", AnyLogical, Rank::scalar, Optionality::optional},
- {"errmsg", DefaultChar, Rank::scalar, Optionality::optional}},
+ {"errmsg", DefaultChar, Rank::scalar, Optionality::optional,
+ common::Intent::InOut}},
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
{"move_alloc",
- {{"from", SameType, Rank::known}, {"to", SameType, Rank::known},
- {"stat", AnyInt, Rank::scalar, Optionality::optional},
- {"errmsg", DefaultChar, Rank::scalar, Optionality::optional}},
+ {{"from", SameType, Rank::known, Optionality::required,
+ common::Intent::InOut},
+ {"to", SameType, Rank::known, Optionality::required,
+ common::Intent::Out},
+ {"stat", AnyInt, Rank::scalar, Optionality::optional,
+ common::Intent::Out},
+ {"errmsg", DefaultChar, Rank::scalar, Optionality::optional,
+ common::Intent::InOut}},
{}, Rank::elemental, IntrinsicClass::pureSubroutine},
{"mvbits",
{{"from", SameInt}, {"frompos", AnyInt}, {"len", AnyInt},
- {"to", SameInt}, {"topos", AnyInt}},
+ {"to", SameInt, Rank::elemental, Optionality::required,
+ common::Intent::Out},
+ {"topos", AnyInt}},
{}, Rank::elemental, IntrinsicClass::elementalSubroutine}, // elemental
{"random_init",
{{"repeatable", AnyLogical, Rank::scalar},
{"image_distinct", AnyLogical, Rank::scalar}},
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
- {"random_number", {{"harvest", AnyReal, Rank::known}}, {}, Rank::elemental,
- IntrinsicClass::impureSubroutine},
+ {"random_number",
+ {{"harvest", AnyReal, Rank::known, Optionality::required,
+ common::Intent::Out}},
+ {}, Rank::elemental, IntrinsicClass::impureSubroutine},
{"random_seed",
- {{"size", DefaultInt, Rank::scalar, Optionality::optional},
+ {{"size", DefaultInt, Rank::scalar, Optionality::optional,
+ common::Intent::Out},
{"put", DefaultInt, Rank::vector, Optionality::optional},
- {"get", DefaultInt, Rank::vector, Optionality::optional}},
+ {"get", DefaultInt, Rank::vector, Optionality::optional,
+ common::Intent::Out}},
{}, Rank::elemental,
IntrinsicClass::impureSubroutine}, // TODO: at most one argument can be
// present
{"system_clock",
- {{"count", AnyInt, Rank::scalar, Optionality::optional},
- {"count_rate", AnyIntOrReal, Rank::scalar, Optionality::optional},
- {"count_max", AnyInt, Rank::scalar, Optionality::optional}},
+ {{"count", AnyInt, Rank::scalar, Optionality::optional,
+ common::Intent::Out},
+ {"count_rate", AnyIntOrReal, Rank::scalar, Optionality::optional,
+ common::Intent::Out},
+ {"count_max", AnyInt, Rank::scalar, Optionality::optional,
+ common::Intent::Out}},
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
};
@@ -1542,6 +1578,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
}
dummyArgs.back().SetOptional();
}
+ dummyArgs.back().SetIntent(d.intent);
}
characteristics::Procedure::Attrs attrs;
if (elementalRank > 0) {
@@ -2148,7 +2185,7 @@ IntrinsicProcTable::Implementation::IsSpecificIntrinsicFunction(
for (int j{0}; j < dummies; ++j) {
characteristics::DummyDataObject dummy{
GetSpecificType(specific.dummy[j].typePattern)};
- dummy.intent = common::Intent::In;
+ dummy.intent = specific.dummy[j].intent;
args.emplace_back(
std::string{specific.dummy[j].keyword}, std::move(dummy));
}
@@ -2230,7 +2267,8 @@ llvm::raw_ostream &IntrinsicDummyArgument::Dump(llvm::raw_ostream &o) const {
o << keyword << '=';
}
return typePattern.Dump(o)
- << ' ' << EnumToString(rank) << ' ' << EnumToString(optionality);
+ << ' ' << EnumToString(rank) << ' ' << EnumToString(optionality)
+ << EnumToString(intent);
}
llvm::raw_ostream &IntrinsicInterface::Dump(llvm::raw_ostream &o) const {
@@ -2273,4 +2311,15 @@ llvm::raw_ostream &IntrinsicProcTable::Implementation::Dump(
llvm::raw_ostream &IntrinsicProcTable::Dump(llvm::raw_ostream &o) const {
return impl_->Dump(o);
}
+
+// In general C846 prohibits allocatable coarrays to be passed to INTENT(OUT)
+// dummy arguments. This rule does not apply to intrinsics in general.
+// Some intrinsic explicitly allow coarray allocatable in their description.
+// It is assumed that unless explicitly allowed for an intrinsic,
+// this is forbidden.
+// Since there are very few intrinsic identified that allow this, they are
+// listed here instead of adding a field in the table.
+bool AcceptsIntentOutAllocatableCoarray(const std::string &intrinsic) {
+ return intrinsic == "move_alloc";
+}
} // namespace Fortran::evaluate
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index fcc395ad1f44..8e6a74280640 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -140,7 +140,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
const std::string &dummyName, evaluate::Expr<evaluate::SomeType> &actual,
characteristics::TypeAndShape &actualType, bool isElemental,
bool actualIsArrayElement, evaluate::FoldingContext &context,
- const Scope *scope) {
+ const Scope *scope, const evaluate::SpecificIntrinsic *intrinsic) {
// Basic type & rank checking
parser::ContextualMessages &messages{context.messages()};
@@ -314,8 +314,10 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
}
}
if (actualLastObject && actualLastObject->IsCoarray() &&
- IsAllocatable(*actualLastSymbol) &&
- dummy.intent == common::Intent::Out) { // C846
+ IsAllocatable(*actualLastSymbol) && dummy.intent == common::Intent::Out &&
+ !(intrinsic &&
+ evaluate::AcceptsIntentOutAllocatableCoarray(
+ intrinsic->name))) { // C846
messages.Say(
"ALLOCATABLE coarray '%s' may not be associated with INTENT(OUT) %s"_err_en_US,
actualLastSymbol->name(), dummyName);
@@ -594,7 +596,7 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
const characteristics::DummyArgument &dummy,
const characteristics::Procedure &proc, evaluate::FoldingContext &context,
- const Scope *scope) {
+ const Scope *scope, const evaluate::SpecificIntrinsic *intrinsic) {
auto &messages{context.messages()};
std::string dummyName{"dummy argument"};
if (!dummy.name.empty()) {
@@ -609,7 +611,8 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
arg.set_dummyIntent(object.intent);
bool isElemental{object.type.Rank() == 0 && proc.IsElemental()};
CheckExplicitDataArg(object, dummyName, *expr, *type,
- isElemental, IsArrayElement(*expr), context, scope);
+ isElemental, IsArrayElement(*expr), context, scope,
+ intrinsic);
} else if (object.type.type().IsTypelessIntrinsicArgument() &&
std::holds_alternative<evaluate::BOZLiteralConstant>(
expr->u)) {
@@ -701,7 +704,8 @@ static void RearrangeArguments(const characteristics::Procedure &proc,
static parser::Messages CheckExplicitInterface(
const characteristics::Procedure &proc, evaluate::ActualArguments &actuals,
- const evaluate::FoldingContext &context, const Scope *scope) {
+ const evaluate::FoldingContext &context, const Scope *scope,
+ const evaluate::SpecificIntrinsic *intrinsic) {
parser::Messages buffer;
parser::ContextualMessages messages{context.messages().at(), &buffer};
RearrangeArguments(proc, actuals, messages);
@@ -711,7 +715,8 @@ static parser::Messages CheckExplicitInterface(
for (auto &actual : actuals) {
const auto &dummy{proc.dummyArguments.at(index++)};
if (actual) {
- CheckExplicitInterfaceArg(*actual, dummy, proc, localContext, scope);
+ CheckExplicitInterfaceArg(
+ *actual, dummy, proc, localContext, scope, intrinsic);
} else if (!dummy.IsOptional()) {
if (dummy.name.empty()) {
messages.Say(
@@ -732,22 +737,25 @@ static parser::Messages CheckExplicitInterface(
parser::Messages CheckExplicitInterface(const characteristics::Procedure &proc,
evaluate::ActualArguments &actuals, const evaluate::FoldingContext &context,
- const Scope &scope) {
- return CheckExplicitInterface(proc, actuals, context, &scope);
+ const Scope &scope, const evaluate::SpecificIntrinsic *intrinsic) {
+ return CheckExplicitInterface(proc, actuals, context, &scope, intrinsic);
}
bool CheckInterfaceForGeneric(const characteristics::Procedure &proc,
evaluate::ActualArguments &actuals,
const evaluate::FoldingContext &context) {
- return CheckExplicitInterface(proc, actuals, context, nullptr).empty();
+ return CheckExplicitInterface(proc, actuals, context, nullptr, nullptr)
+ .empty();
}
void CheckArguments(const characteristics::Procedure &proc,
evaluate::ActualArguments &actuals, evaluate::FoldingContext &context,
- const Scope &scope, bool treatingExternalAsImplicit) {
+ const Scope &scope, bool treatingExternalAsImplicit,
+ const evaluate::SpecificIntrinsic *intrinsic) {
bool explicitInterface{proc.HasExplicitInterface()};
if (explicitInterface) {
- auto buffer{CheckExplicitInterface(proc, actuals, context, scope)};
+ auto buffer{
+ CheckExplicitInterface(proc, actuals, context, scope, intrinsic)};
if (treatingExternalAsImplicit && !buffer.empty()) {
if (auto *msg{context.messages().Say(
"Warning: if the procedure's interface were explicit, this reference would be in error:"_en_US)}) {
diff --git a/flang/lib/Semantics/check-call.h b/flang/lib/Semantics/check-call.h
index be503e49e5cc..43d6b2ac817a 100644
--- a/flang/lib/Semantics/check-call.h
+++ b/flang/lib/Semantics/check-call.h
@@ -27,19 +27,21 @@ class FoldingContext;
namespace Fortran::semantics {
class Scope;
-// The Boolean flag argument should be true when the called procedure
+// Argument treatingExternalAsImplicit should be true when the called procedure
// does not actually have an explicit interface at the call site, but
// its characteristics are known because it is a subroutine or function
// defined at the top level in the same source file.
void CheckArguments(const evaluate::characteristics::Procedure &,
evaluate::ActualArguments &, evaluate::FoldingContext &, const Scope &,
- bool treatingExternalAsImplicit = false);
+ bool treatingExternalAsImplicit,
+ const evaluate::SpecificIntrinsic *intrinsic);
// Checks actual arguments against a procedure with an explicit interface.
// Reports a buffer of errors when not compatible.
parser::Messages CheckExplicitInterface(
const evaluate::characteristics::Procedure &, evaluate::ActualArguments &,
- const evaluate::FoldingContext &, const Scope &);
+ const evaluate::FoldingContext &, const Scope &,
+ const evaluate::SpecificIntrinsic *intrinsic);
// Checks actual arguments for the purpose of resolving a generic interface.
bool CheckInterfaceForGeneric(const evaluate::characteristics::Procedure &,
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 57de714edaff..be4cd6ea5d24 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -2157,7 +2157,8 @@ std::optional<characteristics::Procedure> ExpressionAnalyzer::CheckCall(
}
if (!procIsAssociated) {
semantics::CheckArguments(*chars, arguments, GetFoldingContext(),
- context_.FindScope(callSite), treatExternalAsImplicit);
+ context_.FindScope(callSite), treatExternalAsImplicit,
+ proc.GetSpecificIntrinsic());
const Symbol *procSymbol{proc.GetSymbol()};
if (procSymbol && !IsPureProcedure(*procSymbol)) {
if (const semantics::Scope *
diff --git a/flang/test/Semantics/call03.f90 b/flang/test/Semantics/call03.f90
index 28a0d29ca505..53005f972b19 100644
--- a/flang/test/Semantics/call03.f90
+++ b/flang/test/Semantics/call03.f90
@@ -189,6 +189,8 @@ subroutine test11(in) ! C15.5.2.4(20)
call intentout(x) ! ok
!ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
call intentout((x))
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'count=' must be definable
+ call system_clock(count=2)
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
call intentinout(in)
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
@@ -198,6 +200,8 @@ subroutine test11(in) ! C15.5.2.4(20)
call intentinout(x) ! ok
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
call intentinout((x))
+ !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'exitstat=' must be definable
+ call execute_command_line(command="echo hello", exitstat=0)
end subroutine
subroutine test12 ! 15.5.2.4(21)
More information about the flang-commits
mailing list