Skip to content

Commit 29d1a49

Browse files
jeanPerierjeanPerier
committed
[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
1 parent c0cdd22 commit 29d1a49

File tree

8 files changed

+140
-50
lines changed

8 files changed

+140
-50
lines changed

‎flang/include/flang/Evaluate/characteristics.h

+2
Original file line numberDiff line numberDiff line change
@@ -233,6 +233,8 @@ struct DummyArgument {
233233
std::string &&, const Expr<SomeType> &, FoldingContext &);
234234
bool IsOptional() const;
235235
void SetOptional(bool = true);
236+
common::Intent GetIntent() const;
237+
void SetIntent(common::Intent);
236238
bool CanBePassedViaImplicitInterface() const;
237239
bool IsTypelessIntrinsicDummy() const;
238240
llvm::raw_ostream &Dump(llvm::raw_ostream &) const;

‎flang/include/flang/Evaluate/intrinsics.h

+4
Original file line numberDiff line numberDiff line change
@@ -102,5 +102,9 @@ class IntrinsicProcTable {
102102
private:
103103
Implementation *impl_{nullptr}; // owning pointer
104104
};
105+
106+
// Check if an intrinsic explicitly allows its INTENT(OUT) arguments to be
107+
// allocatable coarrays.
108+
bool AcceptsIntentOutAllocatableCoarray(const std::string &);
105109
} // namespace Fortran::evaluate
106110
#endif // FORTRAN_EVALUATE_INTRINSICS_H_

‎flang/lib/Evaluate/characteristics.cpp

+20
Original file line numberDiff line numberDiff line change
@@ -448,6 +448,26 @@ void DummyArgument::SetOptional(bool value) {
448448
u);
449449
}
450450

451+
void DummyArgument::SetIntent(common::Intent intent) {
452+
std::visit(common::visitors{
453+
[intent](DummyDataObject &data) { data.intent = intent; },
454+
[intent](DummyProcedure &proc) { proc.intent = intent; },
455+
[](AlternateReturn &) { DIE("cannot set intent"); },
456+
},
457+
u);
458+
}
459+
460+
common::Intent DummyArgument::GetIntent() const {
461+
return std::visit(common::visitors{
462+
[](const DummyDataObject &data) { return data.intent; },
463+
[](const DummyProcedure &proc) { return proc.intent; },
464+
[](const AlternateReturn &) -> common::Intent {
465+
DIE("Alternate return have no intent");
466+
},
467+
},
468+
u);
469+
}
470+
451471
bool DummyArgument::CanBePassedViaImplicitInterface() const {
452472
if (const auto *object{std::get_if<DummyDataObject>(&u)}) {
453473
return object->CanBePassedViaImplicitInterface();

‎flang/lib/Evaluate/intrinsics.cpp

+83-34
Original file line numberDiff line numberDiff line change
@@ -198,6 +198,7 @@ struct IntrinsicDummyArgument {
198198
TypePattern typePattern;
199199
Rank rank{Rank::elemental};
200200
Optionality optionality{Optionality::required};
201+
common::Intent intent{common::Intent::In};
201202
llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
202203
};
203204

@@ -935,68 +936,103 @@ static const SpecificIntrinsicInterface specificIntrinsicFunction[]{
935936
};
936937

937938
static const IntrinsicInterface intrinsicSubroutine[]{
938-
{"cpu_time", {{"time", AnyReal, Rank::scalar}}, {}, Rank::elemental,
939-
IntrinsicClass::impureSubroutine},
939+
{"cpu_time",
940+
{{"time", AnyReal, Rank::scalar, Optionality::required,
941+
common::Intent::Out}},
942+
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
940943
{"date_and_time",
941-
{{"date", DefaultChar, Rank::scalar, Optionality::optional},
942-
{"time", DefaultChar, Rank::scalar, Optionality::optional},
943-
{"zone", DefaultChar, Rank::scalar, Optionality::optional},
944-
{"values", AnyInt, Rank::vector, Optionality::optional}},
944+
{{"date", DefaultChar, Rank::scalar, Optionality::optional,
945+
common::Intent::Out},
946+
{"time", DefaultChar, Rank::scalar, Optionality::optional,
947+
common::Intent::Out},
948+
{"zone", DefaultChar, Rank::scalar, Optionality::optional,
949+
common::Intent::Out},
950+
{"values", AnyInt, Rank::vector, Optionality::optional,
951+
common::Intent::Out}},
945952
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
946953
{"execute_command_line",
947954
{{"command", DefaultChar, Rank::scalar},
948955
{"wait", AnyLogical, Rank::scalar, Optionality::optional},
949-
{"exitstat", AnyInt, Rank::scalar, Optionality::optional},
950-
{"cmdstat", AnyInt, Rank::scalar, Optionality::optional},
951-
{"cmdmsg", DefaultChar, Rank::scalar, Optionality::optional}},
956+
{"exitstat", AnyInt, Rank::scalar, Optionality::optional,
957+
common::Intent::InOut},
958+
{"cmdstat", AnyInt, Rank::scalar, Optionality::optional,
959+
common::Intent::Out},
960+
{"cmdmsg", DefaultChar, Rank::scalar, Optionality::optional,
961+
common::Intent::InOut}},
952962
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
953963
{"get_command",
954-
{{"command", DefaultChar, Rank::scalar, Optionality::optional},
955-
{"length", AnyInt, Rank::scalar, Optionality::optional},
956-
{"status", AnyInt, Rank::scalar, Optionality::optional},
957-
{"errmsg", DefaultChar, Rank::scalar, Optionality::optional}},
964+
{{"command", DefaultChar, Rank::scalar, Optionality::optional,
965+
common::Intent::Out},
966+
{"length", AnyInt, Rank::scalar, Optionality::optional,
967+
common::Intent::Out},
968+
{"status", AnyInt, Rank::scalar, Optionality::optional,
969+
common::Intent::Out},
970+
{"errmsg", DefaultChar, Rank::scalar, Optionality::optional,
971+
common::Intent::InOut}},
958972
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
959973
{"get_command_argument",
960974
{{"number", AnyInt, Rank::scalar},
961-
{"value", DefaultChar, Rank::scalar, Optionality::optional},
962-
{"length", AnyInt, Rank::scalar, Optionality::optional},
963-
{"status", AnyInt, Rank::scalar, Optionality::optional},
964-
{"errmsg", DefaultChar, Rank::scalar, Optionality::optional}},
975+
{"value", DefaultChar, Rank::scalar, Optionality::optional,
976+
common::Intent::Out},
977+
{"length", AnyInt, Rank::scalar, Optionality::optional,
978+
common::Intent::Out},
979+
{"status", AnyInt, Rank::scalar, Optionality::optional,
980+
common::Intent::Out},
981+
{"errmsg", DefaultChar, Rank::scalar, Optionality::optional,
982+
common::Intent::InOut}},
965983
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
966984
{"get_environment_variable",
967985
{{"name", DefaultChar, Rank::scalar},
968-
{"value", DefaultChar, Rank::scalar, Optionality::optional},
969-
{"length", AnyInt, Rank::scalar, Optionality::optional},
970-
{"status", AnyInt, Rank::scalar, Optionality::optional},
986+
{"value", DefaultChar, Rank::scalar, Optionality::optional,
987+
common::Intent::Out},
988+
{"length", AnyInt, Rank::scalar, Optionality::optional,
989+
common::Intent::Out},
990+
{"status", AnyInt, Rank::scalar, Optionality::optional,
991+
common::Intent::Out},
971992
{"trim_name", AnyLogical, Rank::scalar, Optionality::optional},
972-
{"errmsg", DefaultChar, Rank::scalar, Optionality::optional}},
993+
{"errmsg", DefaultChar, Rank::scalar, Optionality::optional,
994+
common::Intent::InOut}},
973995
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
974996
{"move_alloc",
975-
{{"from", SameType, Rank::known}, {"to", SameType, Rank::known},
976-
{"stat", AnyInt, Rank::scalar, Optionality::optional},
977-
{"errmsg", DefaultChar, Rank::scalar, Optionality::optional}},
997+
{{"from", SameType, Rank::known, Optionality::required,
998+
common::Intent::InOut},
999+
{"to", SameType, Rank::known, Optionality::required,
1000+
common::Intent::Out},
1001+
{"stat", AnyInt, Rank::scalar, Optionality::optional,
1002+
common::Intent::Out},
1003+
{"errmsg", DefaultChar, Rank::scalar, Optionality::optional,
1004+
common::Intent::InOut}},
9781005
{}, Rank::elemental, IntrinsicClass::pureSubroutine},
9791006
{"mvbits",
9801007
{{"from", SameInt}, {"frompos", AnyInt}, {"len", AnyInt},
981-
{"to", SameInt}, {"topos", AnyInt}},
1008+
{"to", SameInt, Rank::elemental, Optionality::required,
1009+
common::Intent::Out},
1010+
{"topos", AnyInt}},
9821011
{}, Rank::elemental, IntrinsicClass::elementalSubroutine}, // elemental
9831012
{"random_init",
9841013
{{"repeatable", AnyLogical, Rank::scalar},
9851014
{"image_distinct", AnyLogical, Rank::scalar}},
9861015
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
987-
{"random_number", {{"harvest", AnyReal, Rank::known}}, {}, Rank::elemental,
988-
IntrinsicClass::impureSubroutine},
1016+
{"random_number",
1017+
{{"harvest", AnyReal, Rank::known, Optionality::required,
1018+
common::Intent::Out}},
1019+
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
9891020
{"random_seed",
990-
{{"size", DefaultInt, Rank::scalar, Optionality::optional},
1021+
{{"size", DefaultInt, Rank::scalar, Optionality::optional,
1022+
common::Intent::Out},
9911023
{"put", DefaultInt, Rank::vector, Optionality::optional},
992-
{"get", DefaultInt, Rank::vector, Optionality::optional}},
1024+
{"get", DefaultInt, Rank::vector, Optionality::optional,
1025+
common::Intent::Out}},
9931026
{}, Rank::elemental,
9941027
IntrinsicClass::impureSubroutine}, // TODO: at most one argument can be
9951028
// present
9961029
{"system_clock",
997-
{{"count", AnyInt, Rank::scalar, Optionality::optional},
998-
{"count_rate", AnyIntOrReal, Rank::scalar, Optionality::optional},
999-
{"count_max", AnyInt, Rank::scalar, Optionality::optional}},
1030+
{{"count", AnyInt, Rank::scalar, Optionality::optional,
1031+
common::Intent::Out},
1032+
{"count_rate", AnyIntOrReal, Rank::scalar, Optionality::optional,
1033+
common::Intent::Out},
1034+
{"count_max", AnyInt, Rank::scalar, Optionality::optional,
1035+
common::Intent::Out}},
10001036
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
10011037
};
10021038

@@ -1542,6 +1578,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
15421578
}
15431579
dummyArgs.back().SetOptional();
15441580
}
1581+
dummyArgs.back().SetIntent(d.intent);
15451582
}
15461583
characteristics::Procedure::Attrs attrs;
15471584
if (elementalRank > 0) {
@@ -2148,7 +2185,7 @@ IntrinsicProcTable::Implementation::IsSpecificIntrinsicFunction(
21482185
for (int j{0}; j < dummies; ++j) {
21492186
characteristics::DummyDataObject dummy{
21502187
GetSpecificType(specific.dummy[j].typePattern)};
2151-
dummy.intent = common::Intent::In;
2188+
dummy.intent = specific.dummy[j].intent;
21522189
args.emplace_back(
21532190
std::string{specific.dummy[j].keyword}, std::move(dummy));
21542191
}
@@ -2230,7 +2267,8 @@ llvm::raw_ostream &IntrinsicDummyArgument::Dump(llvm::raw_ostream &o) const {
22302267
o << keyword << '=';
22312268
}
22322269
return typePattern.Dump(o)
2233-
<< ' ' << EnumToString(rank) << ' ' << EnumToString(optionality);
2270+
<< ' ' << EnumToString(rank) << ' ' << EnumToString(optionality)
2271+
<< EnumToString(intent);
22342272
}
22352273

22362274
llvm::raw_ostream &IntrinsicInterface::Dump(llvm::raw_ostream &o) const {
@@ -2273,4 +2311,15 @@ llvm::raw_ostream &IntrinsicProcTable::Implementation::Dump(
22732311
llvm::raw_ostream &IntrinsicProcTable::Dump(llvm::raw_ostream &o) const {
22742312
return impl_->Dump(o);
22752313
}
2314+
2315+
// In general C846 prohibits allocatable coarrays to be passed to INTENT(OUT)
2316+
// dummy arguments. This rule does not apply to intrinsics in general.
2317+
// Some intrinsic explicitly allow coarray allocatable in their description.
2318+
// It is assumed that unless explicitly allowed for an intrinsic,
2319+
// this is forbidden.
2320+
// Since there are very few intrinsic identified that allow this, they are
2321+
// listed here instead of adding a field in the table.
2322+
bool AcceptsIntentOutAllocatableCoarray(const std::string &intrinsic) {
2323+
return intrinsic == "move_alloc";
2324+
}
22762325
} // namespace Fortran::evaluate

‎flang/lib/Semantics/check-call.cpp

+20-12
Original file line numberDiff line numberDiff line change
@@ -140,7 +140,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
140140
const std::string &dummyName, evaluate::Expr<evaluate::SomeType> &actual,
141141
characteristics::TypeAndShape &actualType, bool isElemental,
142142
bool actualIsArrayElement, evaluate::FoldingContext &context,
143-
const Scope *scope) {
143+
const Scope *scope, const evaluate::SpecificIntrinsic *intrinsic) {
144144

145145
// Basic type & rank checking
146146
parser::ContextualMessages &messages{context.messages()};
@@ -314,8 +314,10 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
314314
}
315315
}
316316
if (actualLastObject && actualLastObject->IsCoarray() &&
317-
IsAllocatable(*actualLastSymbol) &&
318-
dummy.intent == common::Intent::Out) { // C846
317+
IsAllocatable(*actualLastSymbol) && dummy.intent == common::Intent::Out &&
318+
!(intrinsic &&
319+
evaluate::AcceptsIntentOutAllocatableCoarray(
320+
intrinsic->name))) { // C846
319321
messages.Say(
320322
"ALLOCATABLE coarray '%s' may not be associated with INTENT(OUT) %s"_err_en_US,
321323
actualLastSymbol->name(), dummyName);
@@ -594,7 +596,7 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
594596
static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
595597
const characteristics::DummyArgument &dummy,
596598
const characteristics::Procedure &proc, evaluate::FoldingContext &context,
597-
const Scope *scope) {
599+
const Scope *scope, const evaluate::SpecificIntrinsic *intrinsic) {
598600
auto &messages{context.messages()};
599601
std::string dummyName{"dummy argument"};
600602
if (!dummy.name.empty()) {
@@ -609,7 +611,8 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
609611
arg.set_dummyIntent(object.intent);
610612
bool isElemental{object.type.Rank() == 0 && proc.IsElemental()};
611613
CheckExplicitDataArg(object, dummyName, *expr, *type,
612-
isElemental, IsArrayElement(*expr), context, scope);
614+
isElemental, IsArrayElement(*expr), context, scope,
615+
intrinsic);
613616
} else if (object.type.type().IsTypelessIntrinsicArgument() &&
614617
std::holds_alternative<evaluate::BOZLiteralConstant>(
615618
expr->u)) {
@@ -701,7 +704,8 @@ static void RearrangeArguments(const characteristics::Procedure &proc,
701704

702705
static parser::Messages CheckExplicitInterface(
703706
const characteristics::Procedure &proc, evaluate::ActualArguments &actuals,
704-
const evaluate::FoldingContext &context, const Scope *scope) {
707+
const evaluate::FoldingContext &context, const Scope *scope,
708+
const evaluate::SpecificIntrinsic *intrinsic) {
705709
parser::Messages buffer;
706710
parser::ContextualMessages messages{context.messages().at(), &buffer};
707711
RearrangeArguments(proc, actuals, messages);
@@ -711,7 +715,8 @@ static parser::Messages CheckExplicitInterface(
711715
for (auto &actual : actuals) {
712716
const auto &dummy{proc.dummyArguments.at(index++)};
713717
if (actual) {
714-
CheckExplicitInterfaceArg(*actual, dummy, proc, localContext, scope);
718+
CheckExplicitInterfaceArg(
719+
*actual, dummy, proc, localContext, scope, intrinsic);
715720
} else if (!dummy.IsOptional()) {
716721
if (dummy.name.empty()) {
717722
messages.Say(
@@ -732,22 +737,25 @@ static parser::Messages CheckExplicitInterface(
732737

733738
parser::Messages CheckExplicitInterface(const characteristics::Procedure &proc,
734739
evaluate::ActualArguments &actuals, const evaluate::FoldingContext &context,
735-
const Scope &scope) {
736-
return CheckExplicitInterface(proc, actuals, context, &scope);
740+
const Scope &scope, const evaluate::SpecificIntrinsic *intrinsic) {
741+
return CheckExplicitInterface(proc, actuals, context, &scope, intrinsic);
737742
}
738743

739744
bool CheckInterfaceForGeneric(const characteristics::Procedure &proc,
740745
evaluate::ActualArguments &actuals,
741746
const evaluate::FoldingContext &context) {
742-
return CheckExplicitInterface(proc, actuals, context, nullptr).empty();
747+
return CheckExplicitInterface(proc, actuals, context, nullptr, nullptr)
748+
.empty();
743749
}
744750

745751
void CheckArguments(const characteristics::Procedure &proc,
746752
evaluate::ActualArguments &actuals, evaluate::FoldingContext &context,
747-
const Scope &scope, bool treatingExternalAsImplicit) {
753+
const Scope &scope, bool treatingExternalAsImplicit,
754+
const evaluate::SpecificIntrinsic *intrinsic) {
748755
bool explicitInterface{proc.HasExplicitInterface()};
749756
if (explicitInterface) {
750-
auto buffer{CheckExplicitInterface(proc, actuals, context, scope)};
757+
auto buffer{
758+
CheckExplicitInterface(proc, actuals, context, scope, intrinsic)};
751759
if (treatingExternalAsImplicit && !buffer.empty()) {
752760
if (auto *msg{context.messages().Say(
753761
"Warning: if the procedure's interface were explicit, this reference would be in error:"_en_US)}) {

‎flang/lib/Semantics/check-call.h

+5-3
Original file line numberDiff line numberDiff line change
@@ -27,19 +27,21 @@ class FoldingContext;
2727
namespace Fortran::semantics {
2828
class Scope;
2929

30-
// The Boolean flag argument should be true when the called procedure
30+
// Argument treatingExternalAsImplicit should be true when the called procedure
3131
// does not actually have an explicit interface at the call site, but
3232
// its characteristics are known because it is a subroutine or function
3333
// defined at the top level in the same source file.
3434
void CheckArguments(const evaluate::characteristics::Procedure &,
3535
evaluate::ActualArguments &, evaluate::FoldingContext &, const Scope &,
36-
bool treatingExternalAsImplicit = false);
36+
bool treatingExternalAsImplicit,
37+
const evaluate::SpecificIntrinsic *intrinsic);
3738

3839
// Checks actual arguments against a procedure with an explicit interface.
3940
// Reports a buffer of errors when not compatible.
4041
parser::Messages CheckExplicitInterface(
4142
const evaluate::characteristics::Procedure &, evaluate::ActualArguments &,
42-
const evaluate::FoldingContext &, const Scope &);
43+
const evaluate::FoldingContext &, const Scope &,
44+
const evaluate::SpecificIntrinsic *intrinsic);
4345

4446
// Checks actual arguments for the purpose of resolving a generic interface.
4547
bool CheckInterfaceForGeneric(const evaluate::characteristics::Procedure &,

‎flang/lib/Semantics/expression.cpp

+2-1
Original file line numberDiff line numberDiff line change
@@ -2157,7 +2157,8 @@ std::optional<characteristics::Procedure> ExpressionAnalyzer::CheckCall(
21572157
}
21582158
if (!procIsAssociated) {
21592159
semantics::CheckArguments(*chars, arguments, GetFoldingContext(),
2160-
context_.FindScope(callSite), treatExternalAsImplicit);
2160+
context_.FindScope(callSite), treatExternalAsImplicit,
2161+
proc.GetSpecificIntrinsic());
21612162
const Symbol *procSymbol{proc.GetSymbol()};
21622163
if (procSymbol && !IsPureProcedure(*procSymbol)) {
21632164
if (const semantics::Scope *

‎flang/test/Semantics/call03.f90

+4
Original file line numberDiff line numberDiff line change
@@ -189,6 +189,8 @@ subroutine test11(in) ! C15.5.2.4(20)
189189
call intentout(x) ! ok
190190
!ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
191191
call intentout((x))
192+
!ERROR: Actual argument associated with INTENT(OUT) dummy argument 'count=' must be definable
193+
call system_clock(count=2)
192194
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
193195
call intentinout(in)
194196
!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)
198200
call intentinout(x) ! ok
199201
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
200202
call intentinout((x))
203+
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'exitstat=' must be definable
204+
call execute_command_line(command="echo hello", exitstat=0)
201205
end subroutine
202206

203207
subroutine test12 ! 15.5.2.4(21)

0 commit comments

Comments
 (0)