}
static bool AreCompatibleDummyDataObjectShapes(const Shape &x, const Shape &y) {
- // TODO: Validate more than just compatible ranks
- return GetRank(x) == GetRank(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(
--- /dev/null
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Detect incompatible argument shapes
+module m
+ contains
+ subroutine s1(a)
+ real, intent(in) :: a(2,3)
+ end
+ subroutine s2(a)
+ real, intent(in) :: a(3,2)
+ end
+ subroutine s1c(s)
+ procedure(s1) :: s
+ end
+ subroutine s2c(s)
+ procedure(s2) :: s
+ end
+end
+
+program main
+ use m
+ procedure(s1), pointer :: ps1
+ procedure(s2), pointer :: ps2
+ 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 s2c(s1)
+ call s2c(s2)
+ 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 'ps2' associated with incompatible procedure designator 's1': incompatible dummy argument #1: incompatible dummy data object shapes
+ ps2 => s1
+ ps2 => s2
+ call s1c(ps1)
+ !ERROR: Actual procedure argument has interface incompatible with dummy argument 's=': incompatible dummy argument #1: incompatible dummy data object shapes
+ call s1c(ps2)
+ !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)
+end