Skip to content

Commit 40d9096

Browse files
authored
[flang] Enforce C15104(5) for coindexed values (#130203)
A object's value can't be copied from another image by means of an intrinsic assignment statement if it has a derived type that contains a pointer subobject ultimate component.
1 parent 73b96cf commit 40d9096

File tree

2 files changed

+17
-4
lines changed

2 files changed

+17
-4
lines changed

flang/lib/Semantics/assignment.cpp

Lines changed: 10 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -134,10 +134,16 @@ static std::optional<std::string> GetPointerComponentDesignatorName(
134134
// Checks C1594(5,6); false if check fails
135135
bool CheckCopyabilityInPureScope(parser::ContextualMessages &messages,
136136
const SomeExpr &expr, const Scope &scope) {
137-
if (const Symbol * base{GetFirstSymbol(expr)}) {
138-
if (const char *why{
139-
WhyBaseObjectIsSuspicious(base->GetUltimate(), scope)}) {
140-
if (auto pointer{GetPointerComponentDesignatorName(expr)}) {
137+
if (auto pointer{GetPointerComponentDesignatorName(expr)}) {
138+
if (const Symbol * base{GetFirstSymbol(expr)}) {
139+
const char *why{WhyBaseObjectIsSuspicious(base->GetUltimate(), scope)};
140+
if (!why) {
141+
if (auto coarray{evaluate::ExtractCoarrayRef(expr)}) {
142+
base = &coarray->GetLastSymbol();
143+
why = "coindexed";
144+
}
145+
}
146+
if (why) {
141147
evaluate::SayWithDeclaration(messages, *base,
142148
"A pure subprogram may not copy the value of '%s' because it is %s"
143149
" and has the POINTER potential subobject component '%s'"_err_en_US,

flang/test/Semantics/call12.f90

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -104,4 +104,11 @@ pure subroutine internal
104104
localhp = hasPtr(z%a)
105105
end subroutine
106106
end function
107+
pure subroutine test2(hpd, hhpd)
108+
use used
109+
type(hasHiddenPtr), intent(in out) :: hpd, hhpd[*]
110+
hpd = hhpd ! ok
111+
!ERROR: A pure subprogram may not copy the value of 'hhpd' because it is coindexed and has the POINTER potential subobject component '%a%p'
112+
hpd = hhpd[1]
113+
end subroutine
107114
end module

0 commit comments

Comments
 (0)