File tree Expand file tree Collapse file tree 2 files changed +46
-3
lines changed Expand file tree Collapse file tree 2 files changed +46
-3
lines changed Original file line number Diff line number Diff line change @@ -650,8 +650,25 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Designator &d) {
650650 dataRef = ExtractDataRef (std::move (result),
651651 /* intoSubstring=*/ false , /* intoComplexPart=*/ true );
652652 }
653- if (dataRef && !CheckDataRef (*dataRef)) {
654- result.reset ();
653+ if (dataRef) {
654+ if (!CheckDataRef (*dataRef)) {
655+ result.reset ();
656+ } else if (ExtractCoarrayRef (*dataRef).has_value ()) {
657+ if (auto dyType{result->GetType ()};
658+ dyType && dyType->category () == TypeCategory::Derived) {
659+ if (!std::holds_alternative<CoarrayRef>(dataRef->u ) &&
660+ dyType->IsPolymorphic ()) { // F'2023 C918
661+ Say (" The base of a polymorphic object may not be coindexed" _err_en_US);
662+ }
663+ if (const auto *derived{GetDerivedTypeSpec (*dyType)}) {
664+ if (auto bad{FindPolymorphicAllocatablePotentialComponent (
665+ *derived)}) { // F'2023 C917
666+ Say (" A coindexed designator may not have a type with the polymorphic potential subobject component '%s'" _err_en_US,
667+ bad.BuildResultDesignatorName ());
668+ }
669+ }
670+ }
671+ }
655672 }
656673 }
657674 return result;
Original file line number Diff line number Diff line change 11! RUN: %python %S/test_errors.py %s %flang_fc1
22! More coarray error tests.
3- module m
3+ module m1
44 integer :: local[* ] ! ok in module
55end
66program main
@@ -49,6 +49,32 @@ function func2()
4949 type (t) :: local
5050end
5151
52+ module m2
53+ type t0
54+ integer n
55+ end type
56+ type t1
57+ class(t0), allocatable :: a
58+ end type
59+ type t2
60+ type (t1) c
61+ end type
62+ contains
63+ subroutine test (x )
64+ type (t2), intent (in ) :: x[* ]
65+ ! ERROR: The base of a polymorphic object may not be coindexed
66+ call sub1(x[1 ]% c% a)
67+ ! ERROR: A coindexed designator may not have a type with the polymorphic potential subobject component '%a'
68+ call sub2(x[1 ]% c)
69+ end
70+ subroutine sub1 (x )
71+ type (t0), intent (in ) :: x
72+ end
73+ subroutine sub2 (x )
74+ type (t1), intent (in ) :: x
75+ end
76+ end
77+
5278module m3
5379 type t
5480 real , allocatable :: a(:)
You can’t perform that action at this time.
0 commit comments