Skip to content

Commit af62a6f

Browse files
authored
[flang] Enforce F'2023 constraints C917 & C918 (#129962)
These are constraints that preclude the need to obtain type information from descriptors on other images, essentially. When designating a polymorphic component, its base may not be coindexed; nor shall a coindexed designator have a type with a polymorphic potential subobject component.
1 parent ae23dd5 commit af62a6f

File tree

2 files changed

+46
-3
lines changed

2 files changed

+46
-3
lines changed

flang/lib/Semantics/expression.cpp

Lines changed: 19 additions & 2 deletions
Original file line numberDiff line numberDiff 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;

flang/test/Semantics/coarrays02.f90

Lines changed: 27 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
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
55
end
66
program main
@@ -49,6 +49,32 @@ function func2()
4949
type(t) :: local
5050
end
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+
5278
module m3
5379
type t
5480
real, allocatable :: a(:)

0 commit comments

Comments
 (0)