diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index 14abac5ff9ba8..0e7d97900328b 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 f58c034d5deab..f85feef097cdc 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