[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.
diff --git a/flang/lib/Semantics/assignment.cpp b/flang/lib/Semantics/assignment.cpp
index 8de20d3..935f5a0 100644
--- a/flang/lib/Semantics/assignment.cpp
+++ b/flang/lib/Semantics/assignment.cpp
@@ -134,10 +134,16 @@
// Checks C1594(5,6); false if check fails
bool CheckCopyabilityInPureScope(parser::ContextualMessages &messages,
const SomeExpr &expr, const Scope &scope) {
- if (const Symbol * base{GetFirstSymbol(expr)}) {
- if (const char *why{
- WhyBaseObjectIsSuspicious(base->GetUltimate(), scope)}) {
- if (auto pointer{GetPointerComponentDesignatorName(expr)}) {
+ if (auto pointer{GetPointerComponentDesignatorName(expr)}) {
+ if (const Symbol * base{GetFirstSymbol(expr)}) {
+ const char *why{WhyBaseObjectIsSuspicious(base->GetUltimate(), scope)};
+ if (!why) {
+ if (auto coarray{evaluate::ExtractCoarrayRef(expr)}) {
+ base = &coarray->GetLastSymbol();
+ why = "coindexed";
+ }
+ }
+ if (why) {
evaluate::SayWithDeclaration(messages, *base,
"A pure subprogram may not copy the value of '%s' because it is %s"
" and has the POINTER potential subobject component '%s'"_err_en_US,
diff --git a/flang/test/Semantics/call12.f90 b/flang/test/Semantics/call12.f90
index cd4006a..e7c0fd8 100644
--- a/flang/test/Semantics/call12.f90
+++ b/flang/test/Semantics/call12.f90
@@ -104,4 +104,11 @@
localhp = hasPtr(z%a)
end subroutine
end function
+ pure subroutine test2(hpd, hhpd)
+ use used
+ type(hasHiddenPtr), intent(in out) :: hpd, hhpd[*]
+ hpd = hhpd ! ok
+ !ERROR: A pure subprogram may not copy the value of 'hhpd' because it is coindexed and has the POINTER potential subobject component '%a%p'
+ hpd = hhpd[1]
+ end subroutine
end module
