[flang-commits] [flang] e86591b - [flang] Improve procedure interface compatibility checking for dummy … (#72704)
via flang-commits
flang-commits at lists.llvm.org
Thu Nov 30 12:22:11 PST 2023
Author: Peter Klausler
Date: 2023-11-30T12:22:04-08:00
New Revision: e86591b37d4eb92ffca21b43b224d155ec688337
URL: https://github.com/llvm/llvm-project/commit/e86591b37d4eb92ffca21b43b224d155ec688337
DIFF: https://github.com/llvm/llvm-project/commit/e86591b37d4eb92ffca21b43b224d155ec688337.diff
LOG: [flang] Improve procedure interface compatibility checking for dummy … (#72704)
…arrays
When comparing dummy array extents, cope with references to symbols
better (including references to other dummy arguments), and emit
warnings in dubious cases that are not equivalent but not provably
incompatible.
Added:
Modified:
flang/include/flang/Common/Fortran-features.h
flang/include/flang/Evaluate/characteristics.h
flang/include/flang/Evaluate/tools.h
flang/lib/Evaluate/characteristics.cpp
flang/lib/Evaluate/tools.cpp
flang/lib/Semantics/check-call.cpp
flang/lib/Semantics/pointer-assignment.cpp
flang/test/Semantics/argshape01.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h
index 7e518a210f01cd3..a6b19e9833fc518 100644
--- a/flang/include/flang/Common/Fortran-features.h
+++ b/flang/include/flang/Common/Fortran-features.h
@@ -53,7 +53,7 @@ ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
ShortCharacterActual, ExprPassedToVolatile, ImplicitInterfaceActual,
PolymorphicTransferArg, PointerComponentTransferArg, TransferSizePresence,
F202XAllocatableBreakingChange, DimMustBePresent, CommonBlockPadding,
- LogicalVsCBool, BindCCharLength)
+ LogicalVsCBool, BindCCharLength, ProcDummyArgShapes)
using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
using UsageWarnings = EnumSet<UsageWarning, UsageWarning_enumSize>;
diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index b07affc302622f0..43f8134b93c5c87 100644
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -54,7 +54,8 @@ bool DistinguishableOpOrAssign(const common::LanguageFeatureControl &,
// Shapes of function results and dummy arguments have to have
// the same rank, the same deferred dimensions, and the same
// values for explicit dimensions when constant.
-bool ShapesAreCompatible(const Shape &, const Shape &);
+bool ShapesAreCompatible(
+ const Shape &, const Shape &, bool *possibleWarning = nullptr);
class TypeAndShape {
public:
@@ -222,8 +223,8 @@ struct DummyDataObject {
bool operator!=(const DummyDataObject &that) const {
return !(*this == that);
}
- bool IsCompatibleWith(
- const DummyDataObject &, std::string *whyNot = nullptr) const;
+ bool IsCompatibleWith(const DummyDataObject &, std::string *whyNot = nullptr,
+ std::optional<std::string> *warning = nullptr) const;
static std::optional<DummyDataObject> Characterize(
const semantics::Symbol &, FoldingContext &);
bool CanBePassedViaImplicitInterface() const;
@@ -283,8 +284,8 @@ struct DummyArgument {
void SetIntent(common::Intent);
bool CanBePassedViaImplicitInterface() const;
bool IsTypelessIntrinsicDummy() const;
- bool IsCompatibleWith(
- const DummyArgument &, std::string *whyNot = nullptr) const;
+ bool IsCompatibleWith(const DummyArgument &, std::string *whyNot = nullptr,
+ std::optional<std::string> *warning = nullptr) const;
llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
// name and pass are not characteristics and so do not participate in
@@ -379,7 +380,8 @@ struct Procedure {
bool CanBeCalledViaImplicitInterface() const;
bool CanOverride(const Procedure &, std::optional<int> passIndex) const;
bool IsCompatibleWith(const Procedure &, std::string *whyNot = nullptr,
- const SpecificIntrinsic * = nullptr) const;
+ const SpecificIntrinsic * = nullptr,
+ std::optional<std::string> *warning = nullptr) const;
llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index ba065c4ee1b174e..8a47a9f651661ad 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -1089,11 +1089,12 @@ bool IsExpandableScalar(const Expr<T> &expr, FoldingContext &context,
// Common handling for procedure pointer compatibility of left- and right-hand
// sides. Returns nullopt if they're compatible. Otherwise, it returns a
-// message that needs to be augmented by the names of the left and right sides
+// message that needs to be augmented by the names of the left and right sides.
std::optional<parser::MessageFixedText> CheckProcCompatibility(bool isCall,
const std::optional<characteristics::Procedure> &lhsProcedure,
const characteristics::Procedure *rhsProcedure,
- const SpecificIntrinsic *specificIntrinsic, std::string &whyNotCompatible);
+ const SpecificIntrinsic *specificIntrinsic, std::string &whyNotCompatible,
+ std::optional<std::string> &warning);
// Scalar constant expansion
class ScalarConstantExpander {
@@ -1185,6 +1186,12 @@ class ArrayConstantBoundChanger {
ConstantSubscripts &&lbounds_;
};
+// Predicate: should two expressions be considered identical for the purposes
+// of determining whether two procedure interfaces are compatible, modulo
+// naming of corresponding dummy arguments?
+std::optional<bool> AreEquivalentInInterface(
+ const Expr<SubscriptInteger> &, const Expr<SubscriptInteger> &);
+
} // namespace Fortran::evaluate
namespace Fortran::semantics {
@@ -1261,6 +1268,8 @@ bool AreTkCompatibleTypes(const DeclTypeSpec *x, const DeclTypeSpec *y);
common::IgnoreTKRSet GetIgnoreTKR(const Symbol &);
+std::optional<int> GetDummyArgumentNumber(const Symbol *);
+
} // namespace Fortran::semantics
#endif // FORTRAN_EVALUATE_TOOLS_H_
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 16aa08603bdad41..83ef5d069d3ccc3 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -38,18 +38,23 @@ static void CopyAttrs(const semantics::Symbol &src, A &dst,
// Shapes of function results and dummy arguments have to have
// the same rank, the same deferred dimensions, and the same
// values for explicit dimensions when constant.
-bool ShapesAreCompatible(const Shape &x, const Shape &y) {
+bool ShapesAreCompatible(
+ const Shape &x, const Shape &y, bool *possibleWarning) {
if (x.size() != y.size()) {
return false;
}
auto yIter{y.begin()};
for (const auto &xDim : x) {
const auto &yDim{*yIter++};
- if (xDim) {
- if (!yDim || ToInt64(*xDim) != ToInt64(*yDim)) {
- return false;
+ if (xDim && yDim) {
+ if (auto equiv{AreEquivalentInInterface(*xDim, *yDim)}) {
+ if (!*equiv) {
+ return false;
+ }
+ } else if (possibleWarning) {
+ *possibleWarning = true;
}
- } else if (yDim) {
+ } else if (xDim || yDim) {
return false;
}
}
@@ -270,35 +275,19 @@ llvm::raw_ostream &TypeAndShape::Dump(llvm::raw_ostream &o) const {
bool DummyDataObject::operator==(const DummyDataObject &that) const {
return type == that.type && attrs == that.attrs && intent == that.intent &&
coshape == that.coshape && cudaDataAttr == that.cudaDataAttr;
- ;
-}
-
-static bool AreCompatibleDummyDataObjectShapes(const Shape &x, const Shape &y) {
- int n{GetRank(x)};
- if (n != GetRank(y)) {
- return false;
- }
- auto xIter{x.begin()};
- auto yIter{y.begin()};
- for (; n-- > 0; ++xIter, ++yIter) {
- if (auto xVal{ToInt64(*xIter)}) {
- if (auto yVal{ToInt64(*yIter)}) {
- if (*xVal != *yVal) {
- return false;
- }
- }
- }
- }
- return true;
}
-bool DummyDataObject::IsCompatibleWith(
- const DummyDataObject &actual, std::string *whyNot) const {
- if (!AreCompatibleDummyDataObjectShapes(type.shape(), actual.type.shape())) {
+bool DummyDataObject::IsCompatibleWith(const DummyDataObject &actual,
+ std::string *whyNot, std::optional<std::string> *warning) const {
+ bool possibleWarning{false};
+ if (!ShapesAreCompatible(
+ type.shape(), actual.type.shape(), &possibleWarning)) {
if (whyNot) {
*whyNot = "incompatible dummy data object shapes";
}
return false;
+ } else if (warning && possibleWarning) {
+ *warning = "distinct dummy data object shapes";
}
// Treat deduced dummy character type as if it were assumed-length character
// to avoid useless "implicit interfaces have distinct type" warnings from
@@ -748,11 +737,11 @@ bool DummyArgument::operator==(const DummyArgument &that) const {
return u == that.u; // name and passed-object usage are not characteristics
}
-bool DummyArgument::IsCompatibleWith(
- const DummyArgument &actual, std::string *whyNot) const {
+bool DummyArgument::IsCompatibleWith(const DummyArgument &actual,
+ std::string *whyNot, std::optional<std::string> *warning) const {
if (const auto *ifaceData{std::get_if<DummyDataObject>(&u)}) {
if (const auto *actualData{std::get_if<DummyDataObject>(&actual.u)}) {
- return ifaceData->IsCompatibleWith(*actualData, whyNot);
+ return ifaceData->IsCompatibleWith(*actualData, whyNot, warning);
}
if (whyNot) {
*whyNot = "one dummy argument is an object, the other is not";
@@ -1181,7 +1170,8 @@ bool Procedure::operator==(const Procedure &that) const {
}
bool Procedure::IsCompatibleWith(const Procedure &actual, std::string *whyNot,
- const SpecificIntrinsic *specificIntrinsic) const {
+ const SpecificIntrinsic *specificIntrinsic,
+ std::optional<std::string> *warning) const {
// 15.5.2.9(1): if dummy is not pure, actual need not be.
// Ditto with elemental.
Attrs actualAttrs{actual.attrs};
@@ -1226,13 +1216,17 @@ bool Procedure::IsCompatibleWith(const Procedure &actual, std::string *whyNot,
// subroutine s1(base); subroutine s2(extended)
// procedure(s1), pointer :: p
// p => s2 ! an error, s2 is more restricted, can't handle "base"
+ std::optional<std::string> gotWarning;
if (!actual.dummyArguments[j].IsCompatibleWith(
- dummyArguments[j], whyNot)) {
+ dummyArguments[j], whyNot, warning ? &gotWarning : nullptr)) {
if (whyNot) {
*whyNot = "incompatible dummy argument #"s + std::to_string(j + 1) +
": "s + *whyNot;
}
return false;
+ } else if (warning && !*warning && gotWarning) {
+ *warning = "possibly incompatible dummy argument #"s +
+ std::to_string(j + 1) + ": "s + std::move(*gotWarning);
}
}
return true;
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 9d51649652537ed..8c755da4a2d8b81 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -1082,7 +1082,8 @@ std::optional<std::string> FindImpureCall(
std::optional<parser::MessageFixedText> CheckProcCompatibility(bool isCall,
const std::optional<characteristics::Procedure> &lhsProcedure,
const characteristics::Procedure *rhsProcedure,
- const SpecificIntrinsic *specificIntrinsic, std::string &whyNotCompatible) {
+ const SpecificIntrinsic *specificIntrinsic, std::string &whyNotCompatible,
+ std::optional<std::string> &warning) {
std::optional<parser::MessageFixedText> msg;
if (!lhsProcedure) {
msg = "In assignment to object %s, the target '%s' is a procedure"
@@ -1096,8 +1097,8 @@ std::optional<parser::MessageFixedText> CheckProcCompatibility(bool isCall,
*rhsProcedure->functionResult, &whyNotCompatible)) {
msg =
"Function %s associated with incompatible function designator '%s': %s"_err_en_US;
- } else if (lhsProcedure->IsCompatibleWith(
- *rhsProcedure, &whyNotCompatible, specificIntrinsic)) {
+ } else if (lhsProcedure->IsCompatibleWith(*rhsProcedure, &whyNotCompatible,
+ specificIntrinsic, &warning)) {
// OK
} else if (isCall) {
msg = "Procedure %s associated with result of reference to function '%s'"
@@ -1275,6 +1276,83 @@ std::optional<Expr<SomeType>> HollerithToBOZ(FoldingContext &context,
}
}
+// Extracts a whole symbol being used as a bound of a dummy argument,
+// possibly wrapped with parentheses or MAX(0, ...).
+template <int KIND>
+static const Symbol *GetBoundSymbol(
+ const Expr<Type<TypeCategory::Integer, KIND>> &expr) {
+ using T = Type<TypeCategory::Integer, KIND>;
+ return common::visit(
+ common::visitors{
+ [](const Extremum<T> &max) -> const Symbol * {
+ if (max.ordering == Ordering::Greater) {
+ if (auto zero{ToInt64(max.left())}; zero && *zero == 0) {
+ return GetBoundSymbol(max.right());
+ }
+ }
+ return nullptr;
+ },
+ [](const Parentheses<T> &x) { return GetBoundSymbol(x.left()); },
+ [](const Designator<T> &x) -> const Symbol * {
+ if (const auto *ref{std::get_if<SymbolRef>(&x.u)}) {
+ return &**ref;
+ }
+ return nullptr;
+ },
+ [](const Convert<T, TypeCategory::Integer> &x) {
+ return common::visit(
+ [](const auto &y) -> const Symbol * {
+ using yType = std::decay_t<decltype(y)>;
+ using yResult = typename yType::Result;
+ if constexpr (yResult::kind <= KIND) {
+ return GetBoundSymbol(y);
+ } else {
+ return nullptr;
+ }
+ },
+ x.left().u);
+ },
+ [](const auto &) -> const Symbol * { return nullptr; },
+ },
+ expr.u);
+}
+
+std::optional<bool> AreEquivalentInInterface(
+ const Expr<SubscriptInteger> &x, const Expr<SubscriptInteger> &y) {
+ auto xVal{ToInt64(x)};
+ auto yVal{ToInt64(y)};
+ if (xVal && yVal) {
+ return *xVal == *yVal;
+ } else if (xVal || yVal) {
+ return false;
+ }
+ const Symbol *xSym{GetBoundSymbol(x)};
+ const Symbol *ySym{GetBoundSymbol(y)};
+ if (xSym && ySym) {
+ if (&xSym->GetUltimate() == &ySym->GetUltimate()) {
+ return true; // USE/host associated same symbol
+ }
+ auto xNum{semantics::GetDummyArgumentNumber(xSym)};
+ auto yNum{semantics::GetDummyArgumentNumber(ySym)};
+ if (xNum && yNum) {
+ if (*xNum == *yNum) {
+ auto xType{DynamicType::From(*xSym)};
+ auto yType{DynamicType::From(*ySym)};
+ return xType && yType && xType->IsEquivalentTo(*yType);
+ }
+ }
+ return false;
+ } else if (xSym || ySym) {
+ return false;
+ }
+ // Neither expression is an integer constant or a whole symbol.
+ if (x == y) {
+ return true;
+ } else {
+ return std::nullopt; // not sure
+ }
+}
+
} // namespace Fortran::evaluate
namespace Fortran::semantics {
@@ -1788,4 +1866,23 @@ common::IgnoreTKRSet GetIgnoreTKR(const Symbol &symbol) {
return result;
}
+std::optional<int> GetDummyArgumentNumber(const Symbol *symbol) {
+ if (symbol) {
+ if (IsDummy(*symbol)) {
+ if (const Symbol * subpSym{symbol->owner().symbol()}) {
+ if (const auto *subp{subpSym->detailsIf<SubprogramDetails>()}) {
+ int j{0};
+ for (const Symbol *dummy : subp->dummyArgs()) {
+ if (dummy == symbol) {
+ return j;
+ }
+ ++j;
+ }
+ }
+ }
+ }
+ }
+ return std::nullopt;
+}
+
} // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index f28a44e27ad68a4..ca9fffaeeaf29ff 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -971,7 +971,9 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
}
if (interface.HasExplicitInterface()) {
std::string whyNot;
- if (!interface.IsCompatibleWith(argInterface, &whyNot)) {
+ std::optional<std::string> warning;
+ if (!interface.IsCompatibleWith(argInterface, &whyNot,
+ /*specificIntrinsic=*/nullptr, &warning)) {
// 15.5.2.9(1): Explicit interfaces must match
if (argInterface.HasExplicitInterface()) {
messages.Say(
@@ -988,6 +990,11 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
"Actual procedure argument has an implicit interface which is not known to be compatible with %s which has an explicit interface"_warn_en_US,
dummyName);
}
+ } else if (warning &&
+ context.ShouldWarn(common::UsageWarning::ProcDummyArgShapes)) {
+ messages.Say(
+ "Actual procedure argument has possible interface incompatibility with %s: %s"_warn_en_US,
+ dummyName, std::move(*warning));
}
} else { // 15.5.2.9(2,3)
if (interface.IsSubroutine() && argInterface.IsFunction()) {
@@ -1351,6 +1358,7 @@ static void CheckAssociated(evaluate::ActualArguments &arguments,
*targetExpr, foldingContext)}) {
bool isCall{!!UnwrapProcedureRef(*targetExpr)};
std::string whyNot;
+ std::optional<std::string> warning;
const auto *targetProcDesignator{
evaluate::UnwrapExpr<evaluate::ProcedureDesignator>(
*targetExpr)};
@@ -1358,9 +1366,17 @@ static void CheckAssociated(evaluate::ActualArguments &arguments,
targetProcDesignator
? targetProcDesignator->GetSpecificIntrinsic()
: nullptr};
- if (std::optional<parser::MessageFixedText> msg{
- CheckProcCompatibility(isCall, pointerProc,
- &*targetProc, specificIntrinsic, whyNot)}) {
+ std::optional<parser::MessageFixedText> msg{
+ CheckProcCompatibility(isCall, pointerProc, &*targetProc,
+ specificIntrinsic, whyNot, warning)};
+ if (!msg && warning &&
+ semanticsContext.ShouldWarn(
+ common::UsageWarning::ProcDummyArgShapes)) {
+ msg =
+ "Procedures '%s' and '%s' may not be completely compatible: %s"_warn_en_US;
+ whyNot = std::move(*warning);
+ }
+ if (msg) {
msg->set_severity(parser::Severity::Warning);
messages.Say(std::move(*msg),
"pointer '" + pointerExpr->AsFortran() + "'",
diff --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp
index 0dcaa4e3f2a359c..4c293e85cf9de9c 100644
--- a/flang/lib/Semantics/pointer-assignment.cpp
+++ b/flang/lib/Semantics/pointer-assignment.cpp
@@ -359,12 +359,18 @@ bool PointerAssignmentChecker::Check(parser::CharBlock rhsName, bool isCall,
const Procedure *rhsProcedure,
const evaluate::SpecificIntrinsic *specific) {
std::string whyNot;
+ std::optional<std::string> warning;
CharacterizeProcedure();
if (std::optional<MessageFixedText> msg{evaluate::CheckProcCompatibility(
- isCall, procedure_, rhsProcedure, specific, whyNot)}) {
+ isCall, procedure_, rhsProcedure, specific, whyNot, warning)}) {
Say(std::move(*msg), description_, rhsName, whyNot);
return false;
}
+ if (context_.ShouldWarn(common::UsageWarning::ProcDummyArgShapes) &&
+ warning) {
+ Say("%s and %s may not be completely compatible procedures: %s"_warn_en_US,
+ description_, rhsName, std::move(*warning));
+ }
return true;
}
diff --git a/flang/test/Semantics/argshape01.f90 b/flang/test/Semantics/argshape01.f90
index b57641a1b898b34..19cca1ca4620a7c 100644
--- a/flang/test/Semantics/argshape01.f90
+++ b/flang/test/Semantics/argshape01.f90
@@ -1,6 +1,7 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
! Detect incompatible argument shapes
module m
+ integer :: ha = 1
contains
subroutine s1(a)
real, intent(in) :: a(2,3)
@@ -17,6 +18,32 @@ subroutine s4(a)
subroutine s5(a)
real, intent(in) :: a(..)
end
+ subroutine s6(a,n,m)
+ integer, intent(in) :: n, m
+ real, intent(in) :: a(n, m)
+ end
+ subroutine s6b(a,nn,mm)
+ integer, intent(in) :: nn, mm
+ real, intent(in) :: a(nn, mm)
+ end
+ subroutine s7(a,n,m)
+ integer, intent(in) :: n, m
+ real, intent(in) :: a(m, n)
+ end
+ subroutine s8(a,n,m)
+ integer, intent(in) :: n, m
+ real, intent(in) :: a(n+1,m+1)
+ end
+ subroutine s8b(a,n,m)
+ integer, intent(in) :: n, m
+ real, intent(in) :: a(n-1,m+2)
+ end
+ subroutine s9(a)
+ real, intent(in) :: a(ha,ha)
+ end
+ subroutine s9b(a)
+ real, intent(in) :: a(ha,ha)
+ end
subroutine s1c(s)
procedure(s1) :: s
end
@@ -32,6 +59,18 @@ subroutine s4c(s)
subroutine s5c(s)
procedure(s5) :: s
end
+ subroutine s6c(s)
+ procedure(s6) :: s
+ end
+ subroutine s7c(s)
+ procedure(s7) :: s
+ end
+ subroutine s8c(s)
+ procedure(s8) :: s
+ end
+ subroutine s9c(s)
+ procedure(s9) :: s
+ end
end
program main
@@ -41,27 +80,54 @@ program main
procedure(s3), pointer :: ps3
procedure(s4), pointer :: ps4
procedure(s5), pointer :: ps5
+ procedure(s6), pointer :: ps6
+ procedure(s7), pointer :: ps7
+ procedure(s8), pointer :: ps8
+ procedure(s9), pointer :: ps9
call s1c(s1)
!ERROR: Actual procedure argument has interface incompatible with dummy argument 's=': incompatible dummy argument #1: incompatible dummy data object shapes
call s1c(s2)
!ERROR: Actual procedure argument has interface incompatible with dummy argument 's=': incompatible dummy argument #1: incompatible dummy data object shapes
call s1c(s3)
- !ERROR: Actual procedure argument has interface incompatible with dummy argument 's=': incompatible dummy argument #1: incompatible dummy data object attributes
+ !ERROR: Actual procedure argument has interface incompatible with dummy argument 's=': incompatible dummy argument #1: incompatible dummy data object shapes
call s1c(s4)
!ERROR: Actual procedure argument has interface incompatible with dummy argument 's=': incompatible dummy argument #1: incompatible dummy data object shapes
call s1c(s5)
+ !ERROR: Actual procedure argument has interface incompatible with dummy argument 's=': distinct numbers of dummy arguments
+ call s1c(s6)
!ERROR: Actual procedure argument has interface incompatible with dummy argument 's=': incompatible dummy argument #1: incompatible dummy data object shapes
call s2c(s1)
call s2c(s2)
+ call s6c(s6)
+ call s6c(s6b)
+ !ERROR: Actual procedure argument has interface incompatible with dummy argument 's=': incompatible dummy argument #1: incompatible dummy data object shapes
+ call s6c(s7)
+ !WARNING: Actual procedure argument has interface incompatible with dummy argument 's=': incompatible dummy argument #1: incompatible dummy data object shapes
+ call s6c(s8)
+ !ERROR: Actual procedure argument has interface incompatible with dummy argument 's=': incompatible dummy argument #1: incompatible dummy data object shapes
+ call s7c(s6)
+ !ERROR: Actual procedure argument has interface incompatible with dummy argument 's=': incompatible dummy argument #1: incompatible dummy data object shapes
+ call s7c(s8)
+ !ERROR: Actual procedure argument has interface incompatible with dummy argument 's=': incompatible dummy argument #1: incompatible dummy data object shapes
+ call s8c(s6)
+ !ERROR: Actual procedure argument has interface incompatible with dummy argument 's=': incompatible dummy argument #1: incompatible dummy data object shapes
+ call s8c(s7)
+ call s8c(s8)
+ !WARNING: Actual procedure argument has possible interface incompatibility with dummy argument 's=': possibly incompatible dummy argument #1: distinct dummy data object shapes
+ call s8c(s8b)
+ call s9c(s9)
+ call s9c(s9b)
ps1 => s1
!ERROR: Procedure pointer 'ps1' associated with incompatible procedure designator 's2': incompatible dummy argument #1: incompatible dummy data object shapes
ps1 => s2
!ERROR: Procedure pointer 'ps1' associated with incompatible procedure designator 's3': incompatible dummy argument #1: incompatible dummy data object shapes
ps1 => s3
- !ERROR: Procedure pointer 'ps1' associated with incompatible procedure designator 's4': incompatible dummy argument #1: incompatible dummy data object attributes
+ !ERROR: Procedure pointer 'ps1' associated with incompatible procedure designator 's4': incompatible dummy argument #1: incompatible dummy data object shapes
ps1 => s4
!ERROR: Procedure pointer 'ps1' associated with incompatible procedure designator 's5': incompatible dummy argument #1: incompatible dummy data object shapes
ps1 => s5
+ !ERROR: Procedure pointer 'ps1' associated with incompatible procedure designator 's6': distinct numbers of dummy arguments
+ ps1 => s6
!ERROR: Procedure pointer 'ps2' associated with incompatible procedure designator 's1': incompatible dummy argument #1: incompatible dummy data object shapes
ps2 => s1
ps2 => s2
@@ -70,11 +136,28 @@ program main
call s1c(ps2)
!ERROR: Actual procedure argument has interface incompatible with dummy argument 's=': incompatible dummy argument #1: incompatible dummy data object shapes
call s1c(ps3)
- !ERROR: Actual procedure argument has interface incompatible with dummy argument 's=': incompatible dummy argument #1: incompatible dummy data object attributes
+ !ERROR: Actual procedure argument has interface incompatible with dummy argument 's=': incompatible dummy argument #1: incompatible dummy data object shapes
call s1c(ps4)
!ERROR: Actual procedure argument has interface incompatible with dummy argument 's=': incompatible dummy argument #1: incompatible dummy data object shapes
call s1c(ps5)
!ERROR: Actual procedure argument has interface incompatible with dummy argument 's=': incompatible dummy argument #1: incompatible dummy data object shapes
call s2c(ps1)
call s2c(ps2)
+ ps6 => s6
+ ps6 => s6b
+ !ERROR: Procedure pointer 'ps6' associated with incompatible procedure designator 's7': incompatible dummy argument #1: incompatible dummy data object shapes
+ ps6 => s7
+ !ERROR: Procedure pointer 'ps6' associated with incompatible procedure designator 's8': incompatible dummy argument #1: incompatible dummy data object shapes
+ ps6 => s8
+ !ERROR: Procedure pointer 'ps7' associated with incompatible procedure designator 's6': incompatible dummy argument #1: incompatible dummy data object shapes
+ ps7 => s6
+ !ERROR: Procedure pointer 'ps7' associated with incompatible procedure designator 's8': incompatible dummy argument #1: incompatible dummy data object shapes
+ ps7 => s8
+ ps8 => s8
+ !WARNING: pointer 'ps8' and s8b may not be completely compatible procedures: possibly incompatible dummy argument #1: distinct dummy data object shapes
+ ps8 => s8b
+ !ERROR: Procedure pointer 'ps8' associated with incompatible procedure designator 's6': incompatible dummy argument #1: incompatible dummy data object shapes
+ ps8 => s6
+ !WARNING: Procedure pointer 'ps8' associated with incompatible procedure designator 's7': incompatible dummy argument #1: incompatible dummy data object shapes
+ ps8 => s7
end
More information about the flang-commits
mailing list