[flang] fix scoping of cray pointer declarations and add check for initialization

flang/lib/Semantics/check-declarations.cpp

@@ -963,7 +963,18 @@ void CheckHelper::CheckObjectEntity(
         "'%s' is a data object and may not be EXTERNAL"_err_en_US,
         symbol.name());
   }
-
+  if (symbol.test(Symbol::Flag::CrayPointee)) {
+    // NB, IsSaved was too smart here.
+    if (details.init()) {
+      messages_.Say(
+          "Cray pointee '%s' may not be initialized"_err_en_US, symbol.name());
+    }
+    if (symbol.attrs().test(Attr::SAVE)) {
+      messages_.Say(
+          "Cray pointee '%s' may not have the SAVE attribute"_err_en_US,
+          symbol.name());
+    }
+  }
   if (derived) {
     bool isUnsavedLocal{
         isLocalVariable && !IsAllocatable(symbol) && !IsSaved(symbol)};

flang/lib/Semantics/resolve-names.cpp

@@ -6650,7 +6650,7 @@ bool DeclarationVisitor::Pre(const parser::BasedPointer &) {
 
 void DeclarationVisitor::Post(const parser::BasedPointer &bp) {
   const parser::ObjectName &pointerName{std::get<0>(bp.t)};
-  auto *pointer{FindSymbol(pointerName)};
+  auto *pointer{FindInScope(pointerName)};
   if (!pointer) {
     pointer = &MakeSymbol(pointerName, ObjectEntityDetails{});
   } else if (!ConvertToObjectEntity(*pointer)) {

flang/lib/Semantics/semantics.cpp

@@ -731,6 +731,7 @@ void DoDumpSymbols(llvm::raw_ostream &os, const Scope &scope, int indent) {
     for (const auto &[pointee, pointer] : scope.crayPointers()) {
       os << " (" << pointer->name() << ',' << pointee << ')';
     }
+    os << '\n';
   }
   for (const auto &pair : scope.commonBlocks()) {
     const auto &symbol{*pair.second};

flang/test/Lower/OpenMP/cray-pointers01.f90

@@ -33,7 +33,7 @@ subroutine set_cray_pointer
 end module
 
 program test_cray_pointers_01
-  real*8, save :: var(*)
+  real*8 :: var(*)
   ! CHECK: %[[BOX_ALLOCA:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf64>>>
   ! CHECK: %[[IVAR_ALLOCA:.*]] = fir.alloca i64 {bindc_name = "ivar", uniq_name = "_QFEivar"}
   ! CHECK: %[[IVAR_DECL_01:.*]]:2 = hlfir.declare %[[IVAR_ALLOCA]] {uniq_name = "_QFEivar"} : (!fir.ref<i64>) -> (!fir.ref<i64>, !fir.ref<i64>)

flang/test/Semantics/declarations08.f90

@@ -5,4 +5,10 @@
 !ERROR: Cray pointee 'x' may not be a member of a COMMON block
 common x
 equivalence(y,z)
+!ERROR: Cray pointee 'v' may not be initialized
+real :: v = 42.0
+pointer(p,v)
+!ERROR: Cray pointee 'u' may not have the SAVE attribute
+save u
+pointer(p, u)
 end

flang/test/Semantics/resolve125.f90

@@ -0,0 +1,64 @@
+! RUN: %flang_fc1 -fdebug-dump-symbols %s 2>&1 | FileCheck %s
+
+!CHECK: Module scope: m1
+!CHECK:       i, PUBLIC size={{[0-9]+}} offset={{[0-9]+}}: ObjectEntity type: REAL({{[0-9]+}}) init:{{.+}}
+!CHECK:       init, PUBLIC (Subroutine): Subprogram ()
+!CHECK:       o, PUBLIC (CrayPointee) size={{[0-9]+}} offset={{[0-9]+}}: ObjectEntity type: REAL({{[0-9]+}})
+!CHECK:       ptr, PUBLIC (CrayPointer) size={{[0-9]+}} offset={{[0-9]+}}: ObjectEntity type: INTEGER({{[0-9]+}})
+module m1
+  implicit none
+  real:: o
+  real:: i = 42.0
+  pointer (ptr, o)
+contains
+  !CHECK: Subprogram scope: init
+  subroutine init
+    implicit none
+    ptr=loc(i)
+    print *, "init : o= ", o
+  end subroutine init
+end module m1
+
+!CHECK: Module scope: m2
+!CHECK:       i, PUBLIC: Use from i in m1
+!CHECK:       i2, PUBLIC size={{[0-9]+}} offset={{[0-9]+}}: ObjectEntity type: REAL({{[0-9]+}}) init:{{.+}}
+!CHECK:       init, PUBLIC (Subroutine): Use from init in m1
+!CHECK:       o, PUBLIC (CrayPointee): Use from o in m1
+!CHECK:       ptr, PUBLIC (CrayPointer): Use from ptr in m1
+!CHECK:       reset, PUBLIC (Subroutine): Subprogram ()
+module m2
+  use m1
+  implicit none
+  real:: i2 = 777.0
+contains
+  !CHECK: Subprogram scope: reset
+  !CHECK:       o2 (CrayPointee) size={{[0-9]+}} offset={{[0-9]+}}: ObjectEntity type: REAL({{[0-9]+}})
+  !CHECK:       ptr (CrayPointer) size={{[0-9]+}} offset={{[0-9]+}}: ObjectEntity type: INTEGER({{[0-9]+}})
+  subroutine reset
+    real::o2
+    pointer (ptr, o2)
+    ptr=loc(i2)
+    print *, "reset : o= ", o, " o2 = ", o2
+    o2 = 666.0
+  end subroutine reset
+end module m2
+
+!CHECK: MainProgram scope: main
+!CHECK:       i: Use from i in m2
+!CHECK:       i2: Use from i2 in m2
+!CHECK:       init (Subroutine): Use from init in m2
+!CHECK:       o (CrayPointee): Use from o in m2
+!CHECK:       ptr (CrayPointer): Use from ptr in m2
+!CHECK:       reset (Subroutine): Use from reset in m2
+program main
+  use m2
+  implicit none
+  call init
+  call reset
+  write(6,*) "main : o = ", o
+  if (o == 42.0) then
+    print *, "pass"
+  else
+    print *, "fail"
+  end if
+end program main