diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index 7b837930bf785..39a58a4e23363 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -650,8 +650,25 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Designator &d) { dataRef = ExtractDataRef(std::move(result), /*intoSubstring=*/false, /*intoComplexPart=*/true); } - if (dataRef && !CheckDataRef(*dataRef)) { - result.reset(); + if (dataRef) { + if (!CheckDataRef(*dataRef)) { + result.reset(); + } else if (ExtractCoarrayRef(*dataRef).has_value()) { + if (auto dyType{result->GetType()}; + dyType && dyType->category() == TypeCategory::Derived) { + if (!std::holds_alternative(dataRef->u) && + dyType->IsPolymorphic()) { // F'2023 C918 + Say("The base of a polymorphic object may not be coindexed"_err_en_US); + } + if (const auto *derived{GetDerivedTypeSpec(*dyType)}) { + if (auto bad{FindPolymorphicAllocatablePotentialComponent( + *derived)}) { // F'2023 C917 + Say("A coindexed designator may not have a type with the polymorphic potential subobject component '%s'"_err_en_US, + bad.BuildResultDesignatorName()); + } + } + } + } } } return result; diff --git a/flang/test/Semantics/coarrays02.f90 b/flang/test/Semantics/coarrays02.f90 index 193e5f8af4e63..dc907161250ab 100644 --- a/flang/test/Semantics/coarrays02.f90 +++ b/flang/test/Semantics/coarrays02.f90 @@ -1,6 +1,6 @@ ! RUN: %python %S/test_errors.py %s %flang_fc1 ! More coarray error tests. -module m +module m1 integer :: local[*] ! ok in module end program main @@ -49,6 +49,32 @@ function func2() type(t) :: local end +module m2 + type t0 + integer n + end type + type t1 + class(t0), allocatable :: a + end type + type t2 + type(t1) c + end type + contains + subroutine test(x) + type(t2), intent(in) :: x[*] + !ERROR: The base of a polymorphic object may not be coindexed + call sub1(x[1]%c%a) + !ERROR: A coindexed designator may not have a type with the polymorphic potential subobject component '%a' + call sub2(x[1]%c) + end + subroutine sub1(x) + type(t0), intent(in) :: x + end + subroutine sub2(x) + type(t1), intent(in) :: x + end +end + module m3 type t real, allocatable :: a(:)