[flang] Catch more bad pointer initialization targets

[klausler]

A pointer variable initialization or pointer component default initialization cannot reference another pointer.

Fixes #82944.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

A pointer variable initialization or pointer component default initialization cannot reference another pointer.

Fixes #82944.

---

Full diff: https://github.com/llvm/llvm-project/pull/83731.diff

2 Files Affected:

• (modified) flang/lib/Evaluate/check-expression.cpp (+19-18)
• (modified) flang/test/Semantics/init01.f90 (+57)

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
 

[psteinfeld]

All builds and tests correctly and looks good.