[flang-commits] [flang] c11b445 - [flang] Selectors whose expressions are pointers returned from functions are valid targets
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Thu Oct 6 11:30:46 PDT 2022
Author: Peter Klausler
Date: 2022-10-06T11:30:19-07:00
New Revision: c11b4456c2e32866c4a43bf4e6785091e64b8db5
URL: https://github.com/llvm/llvm-project/commit/c11b4456c2e32866c4a43bf4e6785091e64b8db5
DIFF: https://github.com/llvm/llvm-project/commit/c11b4456c2e32866c4a43bf4e6785091e64b8db5.diff
LOG: [flang] Selectors whose expressions are pointers returned from functions are valid targets
An ASSOCIATE or SELECT TYPE statement's selector whose "right-hand side" is the result
of a reference to a function that returns a pointer must be usable as a valid target
(but not as a pointer).
Differential Revision: https://reviews.llvm.org/D135211
Added:
flang/test/Semantics/associate01.f90
Modified:
flang/docs/Extensions.md
flang/include/flang/Evaluate/tools.h
flang/lib/Evaluate/tools.cpp
flang/lib/Lower/HostAssociations.cpp
Removed:
################################################################################
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index f2bce2f86557d..63f85baaf3705 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -343,6 +343,13 @@ end
This Fortran 2008 feature might as well be viewed like an
extension; no other compiler that we've tested can handle
it yet.
+* According to 11.1.3.3p1, if a selector of an `ASSOCIATE` or
+ related construct is defined by a variable, it has the `TARGET`
+ attribute if the variable was a `POINTER` or `TARGET`.
+ We read this to include the case of the variable being a
+ pointer-valued function reference.
+ No other Fortran compiler seems to handle this correctly for
+ `ASSOCIATE`, though NAG gets it right for `SELECT TYPE`.
## Behavior in cases where the standard is ambiguous or indefinite
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index 85de4805958b8..4d3f8b760e6bb 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -893,8 +893,13 @@ template <typename A> const Symbol *GetLastSymbol(const A &x) {
}
}
-// Convenience: If GetLastSymbol() succeeds on the argument, return its
-// set of attributes, otherwise the empty set.
+// If a function reference constitutes an entire expression, return a pointer
+// to its PrcedureRef.
+const ProcedureRef *GetProcedureRef(const Expr<SomeType> &);
+
+// For everyday variables: if GetLastSymbol() succeeds on the argument, return
+// its set of attributes, otherwise the empty set. Also works on variables that
+// are pointer results of functions.
template <typename A> semantics::Attrs GetAttrs(const A &x) {
if (const Symbol * symbol{GetLastSymbol(x)}) {
return symbol->attrs();
@@ -903,6 +908,37 @@ template <typename A> semantics::Attrs GetAttrs(const A &x) {
}
}
+template <>
+inline semantics::Attrs GetAttrs<Expr<SomeType>>(const Expr<SomeType> &x) {
+ if (IsVariable(x)) {
+ if (const auto *procRef{GetProcedureRef(x)}) {
+ if (const Symbol * interface{procRef->proc().GetInterfaceSymbol()}) {
+ if (const auto *details{
+ interface->detailsIf<semantics::SubprogramDetails>()}) {
+ if (details->isFunction() &&
+ details->result().attrs().test(semantics::Attr::POINTER)) {
+ // N.B.: POINTER becomes TARGET in SetAttrsFromAssociation()
+ return details->result().attrs();
+ }
+ }
+ }
+ }
+ }
+ if (const Symbol * symbol{GetLastSymbol(x)}) {
+ return symbol->attrs();
+ } else {
+ return {};
+ }
+}
+
+template <typename A> semantics::Attrs GetAttrs(const std::optional<A> &x) {
+ if (x) {
+ return GetAttrs(*x);
+ } else {
+ return {};
+ }
+}
+
// GetBaseObject()
template <typename A> std::optional<BaseObject> GetBaseObject(const A &) {
return std::nullopt;
@@ -924,14 +960,8 @@ std::optional<BaseObject> GetBaseObject(const std::optional<A> &x) {
}
}
-// Predicate: IsAllocatableOrPointer()
-template <typename A> bool IsAllocatableOrPointer(const A &x) {
- return GetAttrs(x).HasAny(
- semantics::Attrs{semantics::Attr::POINTER, semantics::Attr::ALLOCATABLE});
-}
-
// Like IsAllocatableOrPointer, but accepts pointer function results as being
-// pointers.
+// pointers too.
bool IsAllocatableOrPointerObject(const Expr<SomeType> &, FoldingContext &);
bool IsAllocatableDesignator(const Expr<SomeType> &);
@@ -946,8 +976,6 @@ bool IsNullProcedurePointer(const Expr<SomeType> &);
bool IsNullPointer(const Expr<SomeType> &);
bool IsObjectPointer(const Expr<SomeType> &, FoldingContext &);
-const ProcedureRef *GetProcedureRef(const Expr<SomeType> &);
-
// Can Expr be passed as absent to an optional dummy argument.
// See 15.5.2.12 point 1 for more details.
bool MayBePassedAsAbsentOptional(const Expr<SomeType> &, FoldingContext &);
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 31f9d5c1331e2..9d148ba198a60 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -861,10 +861,12 @@ bool IsBareNullPointer(const Expr<SomeType> *expr) {
// GetSymbolVector()
auto GetSymbolVectorHelper::operator()(const Symbol &x) const -> Result {
if (const auto *details{x.detailsIf<semantics::AssocEntityDetails>()}) {
- return (*this)(details->expr());
- } else {
- return {x.GetUltimate()};
+ if (IsVariable(details->expr()) && !GetProcedureRef(*details->expr())) {
+ // associate(x => variable that is not a pointer returned by a function)
+ return (*this)(details->expr());
+ }
}
+ return {x.GetUltimate()};
}
auto GetSymbolVectorHelper::operator()(const Component &x) const -> Result {
Result result{(*this)(x.base())};
@@ -1475,14 +1477,14 @@ bool IsAssumedShape(const Symbol &symbol) {
const Symbol &ultimate{ResolveAssociations(symbol)};
const auto *object{ultimate.detailsIf<ObjectEntityDetails>()};
return object && object->CanBeAssumedShape() &&
- !evaluate::IsAllocatableOrPointer(ultimate);
+ !semantics::IsAllocatableOrPointer(ultimate);
}
bool IsDeferredShape(const Symbol &symbol) {
const Symbol &ultimate{ResolveAssociations(symbol)};
const auto *object{ultimate.detailsIf<ObjectEntityDetails>()};
return object && object->CanBeDeferredShape() &&
- evaluate::IsAllocatableOrPointer(ultimate);
+ semantics::IsAllocatableOrPointer(ultimate);
}
bool IsFunctionResult(const Symbol &original) {
diff --git a/flang/lib/Lower/HostAssociations.cpp b/flang/lib/Lower/HostAssociations.cpp
index 3e23fabe21134..8b2699939de24 100644
--- a/flang/lib/Lower/HostAssociations.cpp
+++ b/flang/lib/Lower/HostAssociations.cpp
@@ -447,7 +447,7 @@ walkCaptureCategories(T visitor, Fortran::lower::AbstractConverter &converter,
if (Fortran::semantics::IsProcedure(sym))
return CapturedProcedure::visit(visitor, converter, sym, ba);
ba.analyze(sym);
- if (Fortran::evaluate::IsAllocatableOrPointer(sym))
+ if (Fortran::semantics::IsAllocatableOrPointer(sym))
return CapturedAllocatableAndPointer::visit(visitor, converter, sym, ba);
if (ba.isArray())
return CapturedArrays::visit(visitor, converter, sym, ba);
diff --git a/flang/test/Semantics/associate01.f90 b/flang/test/Semantics/associate01.f90
new file mode 100644
index 0000000000000..ded84f62012fd
--- /dev/null
+++ b/flang/test/Semantics/associate01.f90
@@ -0,0 +1,45 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Tests of selectors whose defining expressions are pointer-valued functions;
+! they must be valid targets, but not pointers.
+! (F'2018 11.1.3.3 p1) "The associating entity does not have the ALLOCATABLE or
+! POINTER attributes; it has the TARGET attribute if and only if the selector
+! is a variable and has either the TARGET or POINTER attribute."
+module m1
+ type t
+ contains
+ procedure, nopass :: iptr
+ end type
+ contains
+ function iptr(n)
+ integer, intent(in), target :: n
+ integer, pointer :: iptr
+ iptr => n
+ end function
+ subroutine test
+ type(t) tv
+ integer, target :: itarget
+ integer, pointer :: ip
+ associate (sel => iptr(itarget))
+ ip => sel
+ !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
+ if (.not. associated(sel)) stop
+ end associate
+ associate (sel => tv%iptr(itarget))
+ ip => sel
+ !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
+ if (.not. associated(sel)) stop
+ end associate
+ associate (sel => (iptr(itarget)))
+ !ERROR: In assignment to object pointer 'ip', the target 'sel' is not an object with POINTER or TARGET attributes
+ ip => sel
+ !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
+ if (.not. associated(sel)) stop
+ end associate
+ associate (sel => 0 + iptr(itarget))
+ !ERROR: In assignment to object pointer 'ip', the target 'sel' is not an object with POINTER or TARGET attributes
+ ip => sel
+ !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
+ if (.not. associated(sel)) stop
+ end associate
+ end subroutine
+end module
More information about the flang-commits
mailing list