maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[flang] Avoid spurious error message in function result compatibility 

When checking function interface compatibility for procedure pointer
assignment/initialization or actual/dummy procedure association, don't
emit a diagnositic about function result shape incompatibility unless
the interfaces differ in rank or have distinct constant extents on a
dimension.  Function results whose dimensions are determined by dummy
arguments or host-associated variables are not necessarily incompatible.

Differential Revision: https://reviews.llvm.org/D132162
This commit is contained in:
Peter Klausler 2022-08-18 10:44:50 -07:00
parent 75f9b18988
commit c1a77839cc
1 changed files with 20 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
flang/lib/Evaluate/characteristics.cpp
View File

@ -875,6 +875,23 @@ bool FunctionResult::CanBeReturnedViaImplicitInterface() const {
}
}
static bool AreCompatibleFunctionResultShapes(const Shape &x, const Shape &y) {
int rank{GetRank(x)};
if (GetRank(y) != rank) {
return false;
}
for (int j{0}; j < rank; ++j) {
if (auto xDim{ToInt64(x[j])}) {
if (auto yDim{ToInt64(y[j])}) {
if (*xDim != *yDim) {
return false;
}
}
}
}
return true;
}
bool FunctionResult::IsCompatibleWith(
const FunctionResult &actual, std::string *whyNot) const {
Attrs actualAttrs{actual.attrs};
@ -892,9 +909,10 @@ bool FunctionResult::IsCompatibleWith(
*whyNot = "function results have distinct ranks";
}
} else if (!attrs.test(Attr::Allocatable) && !attrs.test(Attr::Pointer) &&
ifaceTypeShape->shape() != actualTypeShape->shape()) {
!AreCompatibleFunctionResultShapes(
ifaceTypeShape->shape(), actualTypeShape->shape())) {
if (whyNot) {
*whyNot = "function results have distinct extents";
*whyNot = "function results have distinct constant extents";
}
} else if (!ifaceTypeShape->type().IsTkCompatibleWith(
actualTypeShape->type())) {