[flang-commits] [flang] c4ba110 - [flang] Extension to distinguish specific procedures
peter klausler via flang-commits
flang-commits at lists.llvm.org
Fri Oct 22 12:38:28 PDT 2021
Author: peter klausler
Date: 2021-10-22T12:38:21-07:00
New Revision: c4ba1108dd6065dd3cce5edafcebbb6fe4fb3a0e
URL: https://github.com/llvm/llvm-project/commit/c4ba1108dd6065dd3cce5edafcebbb6fe4fb3a0e
DIFF: https://github.com/llvm/llvm-project/commit/c4ba1108dd6065dd3cce5edafcebbb6fe4fb3a0e.diff
LOG: [flang] Extension to distinguish specific procedures
Allocatable dummy arguments can be used to distinguish
two specific procedures in a generic interface when
it is the case that exactly one of them is polymorphic
or exactly one of them is unlimited polymorphic. The
standard requires that an actual argument corresponding
to an (unlimited) polymorphic allocatable dummy argument
must also be an (unlimited) polymorphic allocatable, so an
actual argument that's acceptable to one procedure must
necessarily be a bad match for the other.
Differential Revision: https://reviews.llvm.org/D112237
Added:
Modified:
flang/docs/Extensions.md
flang/include/flang/Common/Fortran-features.h
flang/include/flang/Evaluate/characteristics.h
flang/lib/Evaluate/characteristics.cpp
flang/lib/Semantics/check-declarations.cpp
flang/test/Semantics/resolve53.f90
Removed:
################################################################################
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index d4dacb7e427f..b7cedd987043 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -179,6 +179,13 @@ end
we also treat scalars as being trivially contiguous, so that they
can be used in contexts like data targets in pointer assignments
with bounds remapping.
+* We support some combinations of specific procedures in generic
+ interfaces that a strict reading of the standard would preclude
+ when their calls must nonetheless be distinguishable.
+ Specifically, `ALLOCATABLE` dummy arguments are distinguishing
+ if an actual argument acceptable to one could not be passed to
+ the other & vice versa because exactly one is polymorphic or
+ exactly one is unlimited polymorphic).
### Extensions supported when enabled by options
diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h
index 0a304913dfc5..ddce79405632 100644
--- a/flang/include/flang/Common/Fortran-features.h
+++ b/flang/include/flang/Common/Fortran-features.h
@@ -30,7 +30,8 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
EquivalenceNumericWithCharacter, AdditionalIntrinsics, AnonymousParents,
OldLabelDoEndStatements, LogicalIntegerAssignment, EmptySourceFile,
ProgramReturn, ImplicitNoneTypeNever, ImplicitNoneTypeAlways,
- ForwardRefDummyImplicitNone, OpenAccessAppend, BOZAsDefaultInteger)
+ ForwardRefDummyImplicitNone, OpenAccessAppend, BOZAsDefaultInteger,
+ DistinguishableSpecifics)
using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index 619f3c96b407..098520cf8bc2 100644
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -17,6 +17,7 @@
#include "expression.h"
#include "shape.h"
#include "type.h"
+#include "flang/Common/Fortran-features.h"
#include "flang/Common/Fortran.h"
#include "flang/Common/enum-set.h"
#include "flang/Common/idioms.h"
@@ -43,9 +44,11 @@ namespace Fortran::evaluate::characteristics {
using common::CopyableIndirection;
// Are these procedures distinguishable for a generic name or FINAL?
-bool Distinguishable(const Procedure &, const Procedure &);
+bool Distinguishable(const common::LanguageFeatureControl &, const Procedure &,
+ const Procedure &);
// Are these procedures distinguishable for a generic operator or assignment?
-bool DistinguishableOpOrAssign(const Procedure &, const Procedure &);
+bool DistinguishableOpOrAssign(const common::LanguageFeatureControl &,
+ const Procedure &, const Procedure &);
// Shapes of function results and dummy arguments have to have
// the same rank, the same deferred dimensions, and the same
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 3fd0025dc83f..d61ff9b791e4 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -862,10 +862,13 @@ llvm::raw_ostream &Procedure::Dump(llvm::raw_ostream &o) const {
// Utility class to determine if Procedures, etc. are distinguishable
class DistinguishUtils {
public:
+ explicit DistinguishUtils(const common::LanguageFeatureControl &features)
+ : features_{features} {}
+
// Are these procedures distinguishable for a generic name?
- static bool Distinguishable(const Procedure &, const Procedure &);
+ bool Distinguishable(const Procedure &, const Procedure &) const;
// Are these procedures distinguishable for a generic operator or assignment?
- static bool DistinguishableOpOrAssign(const Procedure &, const Procedure &);
+ bool DistinguishableOpOrAssign(const Procedure &, const Procedure &) const;
private:
struct CountDummyProcedures {
@@ -881,31 +884,33 @@ class DistinguishUtils {
int notOptional{0};
};
- static bool Rule3Distinguishable(const Procedure &, const Procedure &);
- static const DummyArgument *Rule1DistinguishingArg(
- const DummyArguments &, const DummyArguments &);
- static int FindFirstToDistinguishByPosition(
- const DummyArguments &, const DummyArguments &);
- static int FindLastToDistinguishByName(
- const DummyArguments &, const DummyArguments &);
- static int CountCompatibleWith(const DummyArgument &, const DummyArguments &);
- static int CountNotDistinguishableFrom(
- const DummyArgument &, const DummyArguments &);
- static bool Distinguishable(const DummyArgument &, const DummyArgument &);
- static bool Distinguishable(const DummyDataObject &, const DummyDataObject &);
- static bool Distinguishable(const DummyProcedure &, const DummyProcedure &);
- static bool Distinguishable(const FunctionResult &, const FunctionResult &);
- static bool Distinguishable(const TypeAndShape &, const TypeAndShape &);
- static bool IsTkrCompatible(const DummyArgument &, const DummyArgument &);
- static bool IsTkrCompatible(const TypeAndShape &, const TypeAndShape &);
- static const DummyArgument *GetAtEffectivePosition(
- const DummyArguments &, int);
- static const DummyArgument *GetPassArg(const Procedure &);
+ bool Rule3Distinguishable(const Procedure &, const Procedure &) const;
+ const DummyArgument *Rule1DistinguishingArg(
+ const DummyArguments &, const DummyArguments &) const;
+ int FindFirstToDistinguishByPosition(
+ const DummyArguments &, const DummyArguments &) const;
+ int FindLastToDistinguishByName(
+ const DummyArguments &, const DummyArguments &) const;
+ int CountCompatibleWith(const DummyArgument &, const DummyArguments &) const;
+ int CountNotDistinguishableFrom(
+ const DummyArgument &, const DummyArguments &) const;
+ bool Distinguishable(const DummyArgument &, const DummyArgument &) const;
+ bool Distinguishable(const DummyDataObject &, const DummyDataObject &) const;
+ bool Distinguishable(const DummyProcedure &, const DummyProcedure &) const;
+ bool Distinguishable(const FunctionResult &, const FunctionResult &) const;
+ bool Distinguishable(const TypeAndShape &, const TypeAndShape &) const;
+ bool IsTkrCompatible(const DummyArgument &, const DummyArgument &) const;
+ bool IsTkrCompatible(const TypeAndShape &, const TypeAndShape &) const;
+ const DummyArgument *GetAtEffectivePosition(
+ const DummyArguments &, int) const;
+ const DummyArgument *GetPassArg(const Procedure &) const;
+
+ const common::LanguageFeatureControl &features_;
};
// Simpler distinguishability rules for operators and assignment
bool DistinguishUtils::DistinguishableOpOrAssign(
- const Procedure &proc1, const Procedure &proc2) {
+ const Procedure &proc1, const Procedure &proc2) const {
auto &args1{proc1.dummyArguments};
auto &args2{proc2.dummyArguments};
if (args1.size() != args2.size()) {
@@ -920,7 +925,7 @@ bool DistinguishUtils::DistinguishableOpOrAssign(
}
bool DistinguishUtils::Distinguishable(
- const Procedure &proc1, const Procedure &proc2) {
+ const Procedure &proc1, const Procedure &proc2) const {
auto &args1{proc1.dummyArguments};
auto &args2{proc2.dummyArguments};
auto count1{CountDummyProcedures(args1)};
@@ -950,7 +955,7 @@ bool DistinguishUtils::Distinguishable(
// C1514 rule 3: Procedures are distinguishable if both have a passed-object
// dummy argument and those are distinguishable.
bool DistinguishUtils::Rule3Distinguishable(
- const Procedure &proc1, const Procedure &proc2) {
+ const Procedure &proc1, const Procedure &proc2) const {
const DummyArgument *pass1{GetPassArg(proc1)};
const DummyArgument *pass2{GetPassArg(proc2)};
return pass1 && pass2 && Distinguishable(*pass1, *pass2);
@@ -964,7 +969,7 @@ bool DistinguishUtils::Rule3Distinguishable(
// that are not distinguishable from x
// - m is greater than n
const DummyArgument *DistinguishUtils::Rule1DistinguishingArg(
- const DummyArguments &args1, const DummyArguments &args2) {
+ const DummyArguments &args1, const DummyArguments &args2) const {
auto size1{args1.size()};
auto size2{args2.size()};
for (std::size_t i{0}; i < size1 + size2; ++i) {
@@ -986,7 +991,7 @@ const DummyArgument *DistinguishUtils::Rule1DistinguishingArg(
// - args2 has no dummy argument at that effective position
// - the dummy argument at that position is distinguishable from it
int DistinguishUtils::FindFirstToDistinguishByPosition(
- const DummyArguments &args1, const DummyArguments &args2) {
+ const DummyArguments &args1, const DummyArguments &args2) const {
int effective{0}; // position of arg1 in list, ignoring passed arg
for (std::size_t i{0}; i < args1.size(); ++i) {
const DummyArgument &arg1{args1.at(i)};
@@ -1006,7 +1011,7 @@ int DistinguishUtils::FindFirstToDistinguishByPosition(
// - args2 has no dummy argument with that name
// - the dummy argument with that name is distinguishable from it
int DistinguishUtils::FindLastToDistinguishByName(
- const DummyArguments &args1, const DummyArguments &args2) {
+ const DummyArguments &args1, const DummyArguments &args2) const {
std::map<std::string, const DummyArgument *> nameToArg;
for (const auto &arg2 : args2) {
nameToArg.emplace(arg2.name, &arg2);
@@ -1026,7 +1031,7 @@ int DistinguishUtils::FindLastToDistinguishByName(
// Count the dummy data objects in args that are nonoptional, are not
// passed-object, and that x is TKR compatible with
int DistinguishUtils::CountCompatibleWith(
- const DummyArgument &x, const DummyArguments &args) {
+ const DummyArgument &x, const DummyArguments &args) const {
return std::count_if(args.begin(), args.end(), [&](const DummyArgument &y) {
return !y.pass && !y.IsOptional() && IsTkrCompatible(x, y);
});
@@ -1035,7 +1040,7 @@ int DistinguishUtils::CountCompatibleWith(
// Return the number of dummy data objects in args that are not
// distinguishable from x and not passed-object.
int DistinguishUtils::CountNotDistinguishableFrom(
- const DummyArgument &x, const DummyArguments &args) {
+ const DummyArgument &x, const DummyArguments &args) const {
return std::count_if(args.begin(), args.end(), [&](const DummyArgument &y) {
return !y.pass && std::holds_alternative<DummyDataObject>(y.u) &&
!Distinguishable(y, x);
@@ -1043,7 +1048,7 @@ int DistinguishUtils::CountNotDistinguishableFrom(
}
bool DistinguishUtils::Distinguishable(
- const DummyArgument &x, const DummyArgument &y) {
+ const DummyArgument &x, const DummyArgument &y) const {
if (x.u.index() != y.u.index()) {
return true; //
diff erent kind: data/proc/alt-return
}
@@ -1061,7 +1066,7 @@ bool DistinguishUtils::Distinguishable(
}
bool DistinguishUtils::Distinguishable(
- const DummyDataObject &x, const DummyDataObject &y) {
+ const DummyDataObject &x, const DummyDataObject &y) const {
using Attr = DummyDataObject::Attr;
if (Distinguishable(x.type, y.type)) {
return true;
@@ -1071,13 +1076,27 @@ bool DistinguishUtils::Distinguishable(
} else if (y.attrs.test(Attr::Allocatable) && x.attrs.test(Attr::Pointer) &&
x.intent != common::Intent::In) {
return true;
+ } else if (features_.IsEnabled(
+ common::LanguageFeature::DistinguishableSpecifics) &&
+ (x.attrs.test(Attr::Allocatable) || x.attrs.test(Attr::Pointer)) &&
+ (y.attrs.test(Attr::Allocatable) || y.attrs.test(Attr::Pointer)) &&
+ (x.type.type().IsUnlimitedPolymorphic() !=
+ y.type.type().IsUnlimitedPolymorphic() ||
+ x.type.type().IsPolymorphic() != y.type.type().IsPolymorphic())) {
+ // Extension: Per 15.5.2.5(2), an allocatable/pointer dummy and its
+ // corresponding actual argument must both or neither be polymorphic,
+ // and must both or neither be unlimited polymorphic. So when exactly
+ // one of two dummy arguments is polymorphic or unlimited polymorphic,
+ // any actual argument that is admissible to one of them cannot also match
+ // the other one.
+ return true;
} else {
return false;
}
}
bool DistinguishUtils::Distinguishable(
- const DummyProcedure &x, const DummyProcedure &y) {
+ const DummyProcedure &x, const DummyProcedure &y) const {
const Procedure &xProc{x.procedure.value()};
const Procedure &yProc{y.procedure.value()};
if (Distinguishable(xProc, yProc)) {
@@ -1091,7 +1110,7 @@ bool DistinguishUtils::Distinguishable(
}
bool DistinguishUtils::Distinguishable(
- const FunctionResult &x, const FunctionResult &y) {
+ const FunctionResult &x, const FunctionResult &y) const {
if (x.u.index() != y.u.index()) {
return true; // one is data object, one is procedure
}
@@ -1109,19 +1128,19 @@ bool DistinguishUtils::Distinguishable(
}
bool DistinguishUtils::Distinguishable(
- const TypeAndShape &x, const TypeAndShape &y) {
+ const TypeAndShape &x, const TypeAndShape &y) const {
return !IsTkrCompatible(x, y) && !IsTkrCompatible(y, x);
}
// Compatibility based on type, kind, and rank
bool DistinguishUtils::IsTkrCompatible(
- const DummyArgument &x, const DummyArgument &y) {
+ const DummyArgument &x, const DummyArgument &y) const {
const auto *obj1{std::get_if<DummyDataObject>(&x.u)};
const auto *obj2{std::get_if<DummyDataObject>(&y.u)};
return obj1 && obj2 && IsTkrCompatible(obj1->type, obj2->type);
}
bool DistinguishUtils::IsTkrCompatible(
- const TypeAndShape &x, const TypeAndShape &y) {
+ const TypeAndShape &x, const TypeAndShape &y) const {
return x.type().IsTkCompatibleWith(y.type()) &&
(x.attrs().test(TypeAndShape::Attr::AssumedRank) ||
y.attrs().test(TypeAndShape::Attr::AssumedRank) ||
@@ -1130,7 +1149,7 @@ bool DistinguishUtils::IsTkrCompatible(
// Return the argument at the given index, ignoring the passed arg
const DummyArgument *DistinguishUtils::GetAtEffectivePosition(
- const DummyArguments &args, int index) {
+ const DummyArguments &args, int index) const {
for (const DummyArgument &arg : args) {
if (!arg.pass) {
if (index == 0) {
@@ -1143,7 +1162,7 @@ const DummyArgument *DistinguishUtils::GetAtEffectivePosition(
}
// Return the passed-object dummy argument of this procedure, if any
-const DummyArgument *DistinguishUtils::GetPassArg(const Procedure &proc) {
+const DummyArgument *DistinguishUtils::GetPassArg(const Procedure &proc) const {
for (const auto &arg : proc.dummyArguments) {
if (arg.pass) {
return &arg;
@@ -1152,12 +1171,14 @@ const DummyArgument *DistinguishUtils::GetPassArg(const Procedure &proc) {
return nullptr;
}
-bool Distinguishable(const Procedure &x, const Procedure &y) {
- return DistinguishUtils::Distinguishable(x, y);
+bool Distinguishable(const common::LanguageFeatureControl &features,
+ const Procedure &x, const Procedure &y) {
+ return DistinguishUtils{features}.Distinguishable(x, y);
}
-bool DistinguishableOpOrAssign(const Procedure &x, const Procedure &y) {
- return DistinguishUtils::DistinguishableOpOrAssign(x, y);
+bool DistinguishableOpOrAssign(const common::LanguageFeatureControl &features,
+ const Procedure &x, const Procedure &y) {
+ return DistinguishUtils{features}.DistinguishableOpOrAssign(x, y);
}
DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(DummyArgument)
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index a5fd4fa84eef..92a66d26e91a 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -1097,7 +1097,8 @@ bool CheckHelper::CheckDistinguishableFinals(const Symbol &f1,
const Procedure *p1{Characterize(f1)};
const Procedure *p2{Characterize(f2)};
if (p1 && p2) {
- if (characteristics::Distinguishable(*p1, *p2)) {
+ if (characteristics::Distinguishable(
+ context_.languageFeatures(), *p1, *p2)) {
return true;
}
if (auto *msg{messages_.Say(f1Name,
@@ -2290,7 +2291,8 @@ void DistinguishabilityHelper::Check(const Scope &scope) {
auto distinguishable{kind.IsName()
? evaluate::characteristics::Distinguishable
: evaluate::characteristics::DistinguishableOpOrAssign};
- if (!distinguishable(proc, info[i2].procedure)) {
+ if (!distinguishable(
+ context_.languageFeatures(), proc, info[i2].procedure)) {
SayNotDistinguishable(GetTopLevelUnitContaining(scope), name, kind,
symbol, info[i2].symbol);
}
diff --git a/flang/test/Semantics/resolve53.f90 b/flang/test/Semantics/resolve53.f90
index d871848afe8b..4a5e51f27f52 100644
--- a/flang/test/Semantics/resolve53.f90
+++ b/flang/test/Semantics/resolve53.f90
@@ -479,3 +479,29 @@ subroutine s1()
procedure f
end interface
end subroutine s1
+
+! Extensions for distinguishable allocatable arguments; these should not
+! elicit errors from f18
+module m21
+ type :: t
+ end type
+ interface int1
+ procedure s1a, s1b ! only one is polymorphic
+ end interface
+ interface int2
+ procedure s2a, s2b ! only one is unlimited polymorphic
+ end interface
+ contains
+ subroutine s1a(x)
+ type(t), allocatable :: x
+ end subroutine
+ subroutine s1b(x)
+ class(t), allocatable :: x
+ end subroutine
+ subroutine s2a(x)
+ class(t), allocatable :: x
+ end subroutine
+ subroutine s2b(x)
+ class(*), allocatable :: x
+ end subroutine
+end module
More information about the flang-commits
mailing list