mirrors/llvm-project
0
0
Fork 0
mirror of https://github.com/llvm/llvm-project.git synced 2025-04-17 23:36:40 +00:00
Code Issues Projects Releases Wiki Activity

[flang] Refine checks on assignments to coarrays (#129966)

Browse Source 
F'2023 10.2.1.2 paragraph 2 imposes some requirements on the left-hand
sides of assignments when they have coindices, and one was not checked
while another was inaccurately checked. In short, intrinsic assignment
to a coindexed object can't change its type, and neither can it affect
allocatable components.
This commit is contained in:
Peter Klausler 2025-03-10 13:19:39 -07:00 committed by GitHub
parent f6fc29d331
commit bbc27fbb1c
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
2 changed files with 24 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
flang/lib/Semantics/expression.cpp
View File

@ -3345,15 +3345,24 @@ const Assignment *ExpressionAnalyzer::Analyze(const parser::AssignmentStmt &x) {
"in a non-pointer intrinsic assignment statement");
analyzer.CheckForAssumedRank("in an assignment statement");
const Expr<SomeType> &lhs{analyzer.GetExpr(0)};
if (auto dyType{lhs.GetType()};
dyType && dyType->IsPolymorphic()) { // 10.2.1.2p1(1)
const Symbol *lastWhole0{UnwrapWholeSymbolOrComponentDataRef(lhs)};
const Symbol *lastWhole{
lastWhole0 ? &ResolveAssociations(*lastWhole0) : nullptr};
if (!lastWhole || !IsAllocatable(*lastWhole)) {
Say("Left-hand side of assignment may not be polymorphic unless assignment is to an entire allocatable"_err_en_US);
} else if (evaluate::IsCoarray(*lastWhole)) {
Say("Left-hand side of assignment may not be polymorphic if it is a coarray"_err_en_US);
if (auto dyType{lhs.GetType()}) {
if (dyType->IsPolymorphic()) { // 10.2.1.2p1(1)
const Symbol *lastWhole0{UnwrapWholeSymbolOrComponentDataRef(lhs)};
const Symbol *lastWhole{
lastWhole0 ? &ResolveAssociations(*lastWhole0) : nullptr};
if (!lastWhole || !IsAllocatable(*lastWhole)) {
Say("Left-hand side of assignment may not be polymorphic unless assignment is to an entire allocatable"_err_en_US);
} else if (evaluate::IsCoarray(*lastWhole)) {
Say("Left-hand side of assignment may not be polymorphic if it is a coarray"_err_en_US);
}
}
if (auto *derived{GetDerivedTypeSpec(*dyType)}) {
if (auto iter{FindAllocatableUltimateComponent(*derived)}) {
if (ExtractCoarrayRef(lhs)) {
Say("Left-hand side of assignment must not be coindexed due to allocatable ultimate component '%s'"_err_en_US,
iter.BuildResultDesignatorName());
}
}
}
}
}

6
flang/test/Semantics/assign11.f90
View File

@ -4,9 +4,15 @@ program test
class(*), allocatable :: pa
class(*), pointer :: pp
class(*), allocatable :: pac[:]
type t
real, allocatable :: a
end type
type(t) auc[*]
pa = 1 ! ok
!ERROR: Left-hand side of assignment may not be polymorphic unless assignment is to an entire allocatable
pp = 1
!ERROR: Left-hand side of assignment may not be polymorphic if it is a coarray
pac = 1
!ERROR: Left-hand side of assignment must not be coindexed due to allocatable ultimate component '%a'
auc[1] = t()
end