[flang-commits] [flang] [flang] Catch more bad pointer initialization targets (PR #83731)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Sun Mar 3 09:17:06 PST 2024
https://github.com/klausler created https://github.com/llvm/llvm-project/pull/83731
A pointer variable initialization or pointer component default initialization cannot reference another pointer.
Fixes https://github.com/llvm/llvm-project/issues/82944.
>From 6c6a0d570d1975c010ff870a791f491e6a025673 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Sun, 3 Mar 2024 09:14:01 -0800
Subject: [PATCH] [flang] Catch more bad pointer initialization targets
A pointer variable initialization or pointer component default
initialization cannot reference another pointer.
Fixes https://github.com/llvm/llvm-project/issues/82944.
---
flang/lib/Evaluate/check-expression.cpp | 37 ++++++++--------
flang/test/Semantics/init01.f90 | 57 +++++++++++++++++++++++++
2 files changed, 76 insertions(+), 18 deletions(-)
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 14abac5ff9ba80..0e7d97900328bb 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -250,6 +250,8 @@ class IsInitialDataTargetHelper
}
}
return false;
+ } else if (!CheckVarOrComponent(ultimate)) {
+ return false;
} else if (!ultimate.attrs().test(semantics::Attr::TARGET)) {
if (messages_) {
messages_->Say(
@@ -267,7 +269,7 @@ class IsInitialDataTargetHelper
}
return false;
} else {
- return CheckVarOrComponent(ultimate);
+ return true;
}
}
bool operator()(const StaticDataObject &) const { return false; }
@@ -318,24 +320,23 @@ class IsInitialDataTargetHelper
private:
bool CheckVarOrComponent(const semantics::Symbol &symbol) {
const Symbol &ultimate{symbol.GetUltimate()};
- if (IsAllocatable(ultimate)) {
- if (messages_) {
- messages_->Say(
- "An initial data target may not be a reference to an ALLOCATABLE '%s'"_err_en_US,
- ultimate.name());
- emittedMessage_ = true;
- }
- return false;
- } else if (ultimate.Corank() > 0) {
- if (messages_) {
- messages_->Say(
- "An initial data target may not be a reference to a coarray '%s'"_err_en_US,
- ultimate.name());
- emittedMessage_ = true;
- }
- return false;
+ const char *unacceptable{nullptr};
+ if (ultimate.Corank() > 0) {
+ unacceptable = "a coarray";
+ } else if (IsAllocatable(ultimate)) {
+ unacceptable = "an ALLOCATABLE";
+ } else if (IsPointer(ultimate)) {
+ unacceptable = "a POINTER";
+ } else {
+ return true;
}
- return true;
+ if (messages_) {
+ messages_->Say(
+ "An initial data target may not be a reference to %s '%s'"_err_en_US,
+ unacceptable, ultimate.name());
+ emittedMessage_ = true;
+ }
+ return false;
}
parser::ContextualMessages *messages_;
diff --git a/flang/test/Semantics/init01.f90 b/flang/test/Semantics/init01.f90
index f58c034d5deab2..f85feef097cdca 100644
--- a/flang/test/Semantics/init01.f90
+++ b/flang/test/Semantics/init01.f90
@@ -8,6 +8,17 @@ subroutine objectpointers(j)
real, save :: x3
real, target :: x4
real, target, save :: x5(10)
+ real, pointer :: x6
+ type t1
+ real, allocatable :: c1
+ real, allocatable, codimension[:] :: c2
+ real :: c3
+ real :: c4(10)
+ real, pointer :: c5
+ end type
+ type(t1), target, save :: o1
+ type(t1), save :: o2
+ type(t1), target :: o3
!ERROR: An initial data target may not be a reference to an ALLOCATABLE 'x1'
real, pointer :: p1 => x1
!ERROR: An initial data target may not be a reference to a coarray 'x2'
@@ -20,6 +31,52 @@ subroutine objectpointers(j)
real, pointer :: p5 => x5(j)
!ERROR: Pointer has rank 0 but target has rank 1
real, pointer :: p6 => x5
+!ERROR: An initial data target may not be a reference to a POINTER 'x6'
+ real, pointer :: p7 => x6
+!ERROR: An initial data target may not be a reference to an ALLOCATABLE 'c1'
+ real, pointer :: p1o => o1%c1
+!ERROR: An initial data target may not be a reference to a coarray 'c2'
+ real, pointer :: p2o => o1%c2
+!ERROR: An initial data target may not be a reference to an object 'o2' that lacks the TARGET attribute
+ real, pointer :: p3o => o2%c3
+!ERROR: An initial data target may not be a reference to an object 'o3' that lacks the SAVE attribute
+ real, pointer :: p4o => o3%c3
+!ERROR: An initial data target must be a designator with constant subscripts
+ real, pointer :: p5o => o1%c4(j)
+!ERROR: Pointer has rank 0 but target has rank 1
+ real, pointer :: p6o => o1%c4
+!ERROR: An initial data target may not be a reference to a POINTER 'c5'
+ real, pointer :: p7o => o1%c5
+ type t2
+ !ERROR: An initial data target may not be a reference to an ALLOCATABLE 'x1'
+ real, pointer :: p1 => x1
+ !ERROR: An initial data target may not be a reference to a coarray 'x2'
+ real, pointer :: p2 => x2
+ !ERROR: An initial data target may not be a reference to an object 'x3' that lacks the TARGET attribute
+ real, pointer :: p3 => x3
+ !ERROR: An initial data target may not be a reference to an object 'x4' that lacks the SAVE attribute
+ real, pointer :: p4 => x4
+ !ERROR: An initial data target must be a designator with constant subscripts
+ real, pointer :: p5 => x5(j)
+ !ERROR: Pointer has rank 0 but target has rank 1
+ real, pointer :: p6 => x5
+ !ERROR: An initial data target may not be a reference to a POINTER 'x6'
+ real, pointer :: p7 => x6
+ !ERROR: An initial data target may not be a reference to an ALLOCATABLE 'c1'
+ real, pointer :: p1o => o1%c1
+ !ERROR: An initial data target may not be a reference to a coarray 'c2'
+ real, pointer :: p2o => o1%c2
+ !ERROR: An initial data target may not be a reference to an object 'o2' that lacks the TARGET attribute
+ real, pointer :: p3o => o2%c3
+ !ERROR: An initial data target may not be a reference to an object 'o3' that lacks the SAVE attribute
+ real, pointer :: p4o => o3%c3
+ !ERROR: An initial data target must be a designator with constant subscripts
+ real, pointer :: p5o => o1%c4(j)
+ !ERROR: Pointer has rank 0 but target has rank 1
+ real, pointer :: p6o => o1%c4
+ !ERROR: An initial data target may not be a reference to a POINTER 'c5'
+ real, pointer :: p7o => o1%c5
+ end type
!TODO: type incompatibility, non-deferred type parameter values, contiguity
More information about the flang-commits
mailing list