diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index 8d5e034f8624b..318085518cc57 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/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)}; diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index f1d2ba4078236..e0550b3724bef 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/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)) { diff --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp index 10a01039ea0ae..e07054f8ec564 100644 --- a/flang/lib/Semantics/semantics.cpp +++ b/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}; diff --git a/flang/test/Lower/OpenMP/cray-pointers01.f90 b/flang/test/Lower/OpenMP/cray-pointers01.f90 index 87692ccbadfe3..d3a5a3cdd39a3 100644 --- a/flang/test/Lower/OpenMP/cray-pointers01.f90 +++ b/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>> ! 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) -> (!fir.ref, !fir.ref) diff --git a/flang/test/Semantics/declarations08.f90 b/flang/test/Semantics/declarations08.f90 index bd14131b33c28..2c4027d117365 100644 --- a/flang/test/Semantics/declarations08.f90 +++ b/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 diff --git a/flang/test/Semantics/resolve125.f90 b/flang/test/Semantics/resolve125.f90 new file mode 100644 index 0000000000000..e040c006ec179 --- /dev/null +++ b/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 \ No newline at end of file