[flang-commits] [flang] [flang] Enforce F'2023 C15121 (PR #94418)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Wed Jun 5 11:03:23 PDT 2024
https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/94418
>From a65d2ac0d4ba95064ee065e6d47330b96be6d237 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Tue, 4 Jun 2024 17:54:47 -0700
Subject: [PATCH] [flang] Enforce F'2023 C15121
No specification expression in the declaration of the result variable
of an elemental function may depend on the value of a dummy argument.
This ensures that all of the results have the same type when the elemental
function is applied to the elements of an array.
---
.../include/flang/Evaluate/check-expression.h | 23 +--
flang/lib/Evaluate/check-expression.cpp | 161 +++++++++++-------
flang/lib/Semantics/check-declarations.cpp | 47 +++--
.../Lower/HLFIR/elemental-result-length.f90 | 25 ---
flang/test/Semantics/elemental01.f90 | 38 +++++
5 files changed, 175 insertions(+), 119 deletions(-)
diff --git a/flang/include/flang/Evaluate/check-expression.h b/flang/include/flang/Evaluate/check-expression.h
index e942ad7ebfc46..b711d289ba524 100644
--- a/flang/include/flang/Evaluate/check-expression.h
+++ b/flang/include/flang/Evaluate/check-expression.h
@@ -77,23 +77,26 @@ std::optional<Expr<SomeType>> NonPointerInitializationExpr(const Symbol &,
// specification expressions.
template <typename A>
-void CheckSpecificationExpr(
- const A &, const semantics::Scope &, FoldingContext &);
-extern template void CheckSpecificationExpr(
- const Expr<SomeType> &x, const semantics::Scope &, FoldingContext &);
-extern template void CheckSpecificationExpr(
- const Expr<SomeInteger> &x, const semantics::Scope &, FoldingContext &);
+void CheckSpecificationExpr(const A &, const semantics::Scope &,
+ FoldingContext &, bool forElementalFunctionResult);
+extern template void CheckSpecificationExpr(const Expr<SomeType> &x,
+ const semantics::Scope &, FoldingContext &,
+ bool forElementalFunctionResult);
+extern template void CheckSpecificationExpr(const Expr<SomeInteger> &x,
+ const semantics::Scope &, FoldingContext &,
+ bool forElementalFunctionResult);
extern template void CheckSpecificationExpr(const Expr<SubscriptInteger> &x,
- const semantics::Scope &, FoldingContext &);
+ const semantics::Scope &, FoldingContext &,
+ bool forElementalFunctionResult);
extern template void CheckSpecificationExpr(
const std::optional<Expr<SomeType>> &x, const semantics::Scope &,
- FoldingContext &);
+ FoldingContext &, bool forElementalFunctionResult);
extern template void CheckSpecificationExpr(
const std::optional<Expr<SomeInteger>> &x, const semantics::Scope &,
- FoldingContext &);
+ FoldingContext &, bool forElementalFunctionResult);
extern template void CheckSpecificationExpr(
const std::optional<Expr<SubscriptInteger>> &x, const semantics::Scope &,
- FoldingContext &);
+ FoldingContext &, bool forElementalFunctionResult);
// Contiguity & "simple contiguity" (9.5.4)
template <typename A>
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 068514b514215..a4b152c60a72f 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -507,43 +507,6 @@ std::optional<Expr<SomeType>> NonPointerInitializationExpr(const Symbol &symbol,
return std::nullopt;
}
-static bool IsNonLocal(const semantics::Symbol &symbol) {
- return semantics::IsDummy(symbol) || symbol.has<semantics::UseDetails>() ||
- symbol.owner().kind() == semantics::Scope::Kind::Module ||
- semantics::FindCommonBlockContaining(symbol) ||
- symbol.has<semantics::HostAssocDetails>();
-}
-
-static bool IsPermissibleInquiry(const semantics::Symbol &firstSymbol,
- const semantics::Symbol &lastSymbol, DescriptorInquiry::Field field,
- const semantics::Scope &localScope) {
- if (IsNonLocal(firstSymbol)) {
- return true;
- }
- if (&localScope != &firstSymbol.owner()) {
- return true;
- }
- // Inquiries on local objects may not access a deferred bound or length.
- // (This code used to be a switch, but it proved impossible to write it
- // thus without running afoul of bogus warnings from different C++
- // compilers.)
- if (field == DescriptorInquiry::Field::Rank) {
- return true; // always known
- }
- const auto *object{lastSymbol.detailsIf<semantics::ObjectEntityDetails>()};
- if (field == DescriptorInquiry::Field::LowerBound ||
- field == DescriptorInquiry::Field::Extent ||
- field == DescriptorInquiry::Field::Stride) {
- return object && !object->shape().CanBeDeferredShape();
- }
- if (field == DescriptorInquiry::Field::Len) {
- return object && object->type() &&
- object->type()->category() == semantics::DeclTypeSpec::Character &&
- !object->type()->characterTypeSpec().length().isDeferred();
- }
- return false;
-}
-
// Specification expression validation (10.1.11(2), C1010)
class CheckSpecificationExprHelper
: public AnyTraverse<CheckSpecificationExprHelper,
@@ -551,9 +514,10 @@ class CheckSpecificationExprHelper
public:
using Result = std::optional<std::string>;
using Base = AnyTraverse<CheckSpecificationExprHelper, Result>;
- explicit CheckSpecificationExprHelper(
- const semantics::Scope &s, FoldingContext &context)
- : Base{*this}, scope_{s}, context_{context} {}
+ explicit CheckSpecificationExprHelper(const semantics::Scope &s,
+ FoldingContext &context, bool forElementalFunctionResult)
+ : Base{*this}, scope_{s}, context_{context},
+ forElementalFunctionResult_{forElementalFunctionResult} {}
using Base::operator();
Result operator()(const CoarrayRef &) const { return "coindexed reference"; }
@@ -572,7 +536,10 @@ class CheckSpecificationExprHelper
"reference variable '"s +
ultimate.name().ToString() + "'";
} else if (IsDummy(ultimate)) {
- if (ultimate.attrs().test(semantics::Attr::OPTIONAL)) {
+ if (!inInquiry_ && forElementalFunctionResult_) {
+ return "dependence on value of dummy argument '"s +
+ ultimate.name().ToString() + "'";
+ } else if (ultimate.attrs().test(semantics::Attr::OPTIONAL)) {
return "reference to OPTIONAL dummy argument '"s +
ultimate.name().ToString() + "'";
} else if (!inInquiry_ &&
@@ -629,8 +596,8 @@ class CheckSpecificationExprHelper
// expressions will have been converted to expressions over descriptor
// inquiries by Fold().
// Catch REAL, ALLOCATABLE :: X(:); REAL :: Y(SIZE(X))
- if (IsPermissibleInquiry(x.base().GetFirstSymbol(),
- x.base().GetLastSymbol(), x.field(), scope_)) {
+ if (IsPermissibleInquiry(
+ x.base().GetFirstSymbol(), x.base().GetLastSymbol(), x.field())) {
auto restorer{common::ScopedSet(inInquiry_, true)};
return (*this)(x.base());
} else if (IsConstantExpr(x)) {
@@ -641,10 +608,18 @@ class CheckSpecificationExprHelper
}
Result operator()(const TypeParamInquiry &inq) const {
- if (scope_.IsDerivedType() && !IsConstantExpr(inq) &&
- inq.base() /* X%T, not local T */) { // C750, C754
- return "non-constant reference to a type parameter inquiry not "
- "allowed for derived type components or type parameter values";
+ if (scope_.IsDerivedType()) {
+ if (!IsConstantExpr(inq) &&
+ inq.base() /* X%T, not local T */) { // C750, C754
+ return "non-constant reference to a type parameter inquiry not allowed "
+ "for derived type components or type parameter values";
+ }
+ } else if (inq.base() &&
+ IsInquiryAlwaysPermissible(inq.base()->GetFirstSymbol())) {
+ auto restorer{common::ScopedSet(inInquiry_, true)};
+ return (*this)(inq.base());
+ } else if (!IsConstantExpr(inq)) {
+ return "non-constant type parameter inquiry not allowed for local object";
}
return std::nullopt;
}
@@ -719,19 +694,19 @@ class CheckSpecificationExprHelper
intrin.name == "is_contiguous") { // ok
} else if (intrin.name == "len" &&
IsPermissibleInquiry(dataRef->GetFirstSymbol(),
- dataRef->GetLastSymbol(), DescriptorInquiry::Field::Len,
- scope_)) { // ok
+ dataRef->GetLastSymbol(),
+ DescriptorInquiry::Field::Len)) { // ok
} else if (intrin.name == "lbound" &&
IsPermissibleInquiry(dataRef->GetFirstSymbol(),
dataRef->GetLastSymbol(),
- DescriptorInquiry::Field::LowerBound, scope_)) { // ok
+ DescriptorInquiry::Field::LowerBound)) { // ok
} else if ((intrin.name == "shape" || intrin.name == "size" ||
intrin.name == "sizeof" ||
intrin.name == "storage_size" ||
intrin.name == "ubound") &&
IsPermissibleInquiry(dataRef->GetFirstSymbol(),
- dataRef->GetLastSymbol(), DescriptorInquiry::Field::Extent,
- scope_)) { // ok
+ dataRef->GetLastSymbol(),
+ DescriptorInquiry::Field::Extent)) { // ok
} else {
return "non-constant inquiry function '"s + intrin.name +
"' not allowed for local object";
@@ -750,32 +725,86 @@ class CheckSpecificationExprHelper
// Contextual information: this flag is true when in an argument to
// an inquiry intrinsic like SIZE().
mutable bool inInquiry_{false};
+ bool forElementalFunctionResult_{false}; // F'2023 C15121
const std::set<std::string> badIntrinsicsForComponents_{
"allocated", "associated", "extends_type_of", "present", "same_type_as"};
+
+ bool IsInquiryAlwaysPermissible(const semantics::Symbol &) const;
+ bool IsPermissibleInquiry(const semantics::Symbol &firstSymbol,
+ const semantics::Symbol &lastSymbol,
+ DescriptorInquiry::Field field) const;
};
+bool CheckSpecificationExprHelper::IsInquiryAlwaysPermissible(
+ const semantics::Symbol &symbol) const {
+ if (&symbol.owner() != &scope_ || symbol.has<semantics::UseDetails>() ||
+ symbol.owner().kind() == semantics::Scope::Kind::Module ||
+ semantics::FindCommonBlockContaining(symbol) ||
+ symbol.has<semantics::HostAssocDetails>()) {
+ return true; // it's nonlocal
+ } else if (semantics::IsDummy(symbol) && !forElementalFunctionResult_) {
+ return true;
+ } else {
+ return false;
+ }
+}
+
+bool CheckSpecificationExprHelper::IsPermissibleInquiry(
+ const semantics::Symbol &firstSymbol, const semantics::Symbol &lastSymbol,
+ DescriptorInquiry::Field field) const {
+ if (IsInquiryAlwaysPermissible(firstSymbol)) {
+ return true;
+ }
+ // Inquiries on local objects may not access a deferred bound or length.
+ // (This code used to be a switch, but it proved impossible to write it
+ // thus without running afoul of bogus warnings from different C++
+ // compilers.)
+ if (field == DescriptorInquiry::Field::Rank) {
+ return true; // always known
+ }
+ const auto *object{lastSymbol.detailsIf<semantics::ObjectEntityDetails>()};
+ if (field == DescriptorInquiry::Field::LowerBound ||
+ field == DescriptorInquiry::Field::Extent ||
+ field == DescriptorInquiry::Field::Stride) {
+ return object && !object->shape().CanBeDeferredShape();
+ }
+ if (field == DescriptorInquiry::Field::Len) {
+ return object && object->type() &&
+ object->type()->category() == semantics::DeclTypeSpec::Character &&
+ !object->type()->characterTypeSpec().length().isDeferred();
+ }
+ return false;
+}
+
template <typename A>
-void CheckSpecificationExpr(
- const A &x, const semantics::Scope &scope, FoldingContext &context) {
- if (auto why{CheckSpecificationExprHelper{scope, context}(x)}) {
- context.messages().Say(
- "Invalid specification expression: %s"_err_en_US, *why);
+void CheckSpecificationExpr(const A &x, const semantics::Scope &scope,
+ FoldingContext &context, bool forElementalFunctionResult) {
+ if (auto why{CheckSpecificationExprHelper{
+ scope, context, forElementalFunctionResult}(x)}) {
+ context.messages().Say("Invalid specification expression%s: %s"_err_en_US,
+ forElementalFunctionResult ? " for elemental function result" : "",
+ *why);
}
}
-template void CheckSpecificationExpr(
- const Expr<SomeType> &, const semantics::Scope &, FoldingContext &);
-template void CheckSpecificationExpr(
- const Expr<SomeInteger> &, const semantics::Scope &, FoldingContext &);
-template void CheckSpecificationExpr(
- const Expr<SubscriptInteger> &, const semantics::Scope &, FoldingContext &);
+template void CheckSpecificationExpr(const Expr<SomeType> &,
+ const semantics::Scope &, FoldingContext &,
+ bool forElementalFunctionResult);
+template void CheckSpecificationExpr(const Expr<SomeInteger> &,
+ const semantics::Scope &, FoldingContext &,
+ bool forElementalFunctionResult);
+template void CheckSpecificationExpr(const Expr<SubscriptInteger> &,
+ const semantics::Scope &, FoldingContext &,
+ bool forElementalFunctionResult);
template void CheckSpecificationExpr(const std::optional<Expr<SomeType>> &,
- const semantics::Scope &, FoldingContext &);
+ const semantics::Scope &, FoldingContext &,
+ bool forElementalFunctionResult);
template void CheckSpecificationExpr(const std::optional<Expr<SomeInteger>> &,
- const semantics::Scope &, FoldingContext &);
+ const semantics::Scope &, FoldingContext &,
+ bool forElementalFunctionResult);
template void CheckSpecificationExpr(
const std::optional<Expr<SubscriptInteger>> &, const semantics::Scope &,
- FoldingContext &);
+ FoldingContext &, bool forElementalFunctionResult);
// IsContiguous() -- 9.5.4
class IsContiguousHelper
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 25de9d4af1ffb..69309e0055416 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -40,7 +40,9 @@ class CheckHelper {
SemanticsContext &context() { return context_; }
void Check() { Check(context_.globalScope()); }
void Check(const ParamValue &, bool canBeAssumed);
- void Check(const Bound &bound) { CheckSpecExpr(bound.GetExplicit()); }
+ void Check(const Bound &bound) {
+ CheckSpecExpr(bound.GetExplicit(), /*forElementalFunctionResult=*/false);
+ }
void Check(const ShapeSpec &spec) {
Check(spec.lbound());
Check(spec.ubound());
@@ -53,8 +55,10 @@ class CheckHelper {
const Procedure *Characterize(const Symbol &);
private:
- template <typename A> void CheckSpecExpr(const A &x) {
- evaluate::CheckSpecificationExpr(x, DEREF(scope_), foldingContext_);
+ template <typename A>
+ void CheckSpecExpr(const A &x, bool forElementalFunctionResult) {
+ evaluate::CheckSpecificationExpr(
+ x, DEREF(scope_), foldingContext_, forElementalFunctionResult);
}
void CheckValue(const Symbol &, const DerivedTypeSpec *);
void CheckVolatile(const Symbol &, const DerivedTypeSpec *);
@@ -222,7 +226,7 @@ void CheckHelper::Check(const ParamValue &value, bool canBeAssumed) {
"An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, character named constant, or external function result"_err_en_US);
}
} else {
- CheckSpecExpr(value.GetExplicit());
+ CheckSpecExpr(value.GetExplicit(), /*forElementalFunctionResult=*/false);
}
}
@@ -378,24 +382,31 @@ void CheckHelper::Check(const Symbol &symbol) {
} else {
Check(*type, canHaveAssumedParameter);
}
- if (InPure() && InFunction() && IsFunctionResult(symbol)) {
- if (type->IsPolymorphic() && IsAllocatable(symbol)) { // C1585
- messages_.Say(
- "Result of pure function may not be both polymorphic and ALLOCATABLE"_err_en_US);
- }
- if (derived) {
- // These cases would be caught be the general validation of local
- // variables in a pure context, but these messages are more specific.
- if (HasImpureFinal(symbol)) { // C1584
+ if (InFunction() && IsFunctionResult(symbol)) {
+ if (InPure()) {
+ if (type->IsPolymorphic() && IsAllocatable(symbol)) { // C1585
messages_.Say(
- "Result of pure function may not have an impure FINAL subroutine"_err_en_US);
+ "Result of pure function may not be both polymorphic and ALLOCATABLE"_err_en_US);
}
- if (auto bad{FindPolymorphicAllocatableUltimateComponent(*derived)}) {
- SayWithDeclaration(*bad,
- "Result of pure function may not have polymorphic ALLOCATABLE ultimate component '%s'"_err_en_US,
- bad.BuildResultDesignatorName());
+ if (derived) {
+ // These cases would be caught be the general validation of local
+ // variables in a pure context, but these messages are more specific.
+ if (HasImpureFinal(symbol)) { // C1584
+ messages_.Say(
+ "Result of pure function may not have an impure FINAL subroutine"_err_en_US);
+ }
+ if (auto bad{FindPolymorphicAllocatableUltimateComponent(*derived)}) {
+ SayWithDeclaration(*bad,
+ "Result of pure function may not have polymorphic ALLOCATABLE ultimate component '%s'"_err_en_US,
+ bad.BuildResultDesignatorName());
+ }
}
}
+ if (InElemental() && isChar) { // F'2023 C15121
+ CheckSpecExpr(type->characterTypeSpec().length().GetExplicit(),
+ /*forElementalFunctionResult=*/true);
+ // TODO: check PDT LEN parameters
+ }
}
}
if (IsAssumedLengthCharacter(symbol) && IsFunction(symbol)) { // C723
diff --git a/flang/test/Lower/HLFIR/elemental-result-length.f90 b/flang/test/Lower/HLFIR/elemental-result-length.f90
index 0aaf7c93770c9..278ef013d952e 100644
--- a/flang/test/Lower/HLFIR/elemental-result-length.f90
+++ b/flang/test/Lower/HLFIR/elemental-result-length.f90
@@ -8,12 +8,6 @@ elemental function fct1(a, b) result(t)
t = a // b
end function
-elemental function fct2(c) result(t)
- integer, intent(in) :: c
- character(c) :: t
-
-end function
-
subroutine sub2(a,b,c)
character(*), intent(inout) :: c
character(*), intent(in) :: a, b
@@ -42,25 +36,6 @@ subroutine sub2(a,b,c)
! CHECK: %[[RES:.*]] = fir.alloca !fir.char<1,?>(%[[RES_LENGTH]] : index) {bindc_name = ".result"}
! CHECK: fir.call @_QMm1Pfct1
-subroutine sub3(c)
- character(*), intent(inout) :: c(:)
-
- c = fct2(10)
-end subroutine
-
-! CHECK-LABEL: func.func @_QMm1Psub3(
-! CHECK-SAME: %[[ARG0:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>> {fir.bindc_name = "c"}) {
-! CHECK: %[[C10:.*]] = arith.constant 10 : i32
-! CHECK: %[[C:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %{{.*}} {fortran_attrs = #fir.var_attrs<intent_inout>, uniq_name = "_QMm1Fsub3Ec"} : (!fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.dscope) -> (!fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.box<!fir.array<?x!fir.char<1,?>>>)
-! CHECK: %[[ASSOC:.*]]:3 = hlfir.associate %[[C10]] {adapt.valuebyref} : (i32) -> (!fir.ref<i32>, !fir.ref<i32>, i1)
-! CHECK: %[[INPUT_ARG0:.*]]:2 = hlfir.declare %[[ASSOC]]#1 {fortran_attrs = #fir.var_attrs<intent_in>, uniq_name = "_QMm1Ffct2Ec"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
-! CHECK: %[[LOAD_INPUT_ARG0:.*]] = fir.load %[[INPUT_ARG0]]#0 : !fir.ref<i32>
-! CHECK: %[[LOAD_INPUT_ARG0_IDX:.*]] = fir.convert %[[LOAD_INPUT_ARG0]] : (i32) -> index
-! CHECK: %[[CMPI:.*]] = arith.cmpi sgt, %[[LOAD_INPUT_ARG0_IDX]], %c0{{.*}} : index
-! CHECK: %[[LENGTH:.*]] = arith.select %[[CMPI]], %[[LOAD_INPUT_ARG0_IDX]], %c0{{.*}} : index
-! CHECK: %[[RES:.*]] = fir.alloca !fir.char<1,?>(%[[LENGTH]] : index) {bindc_name = ".result"}
-! CHECK: fir.call @_QMm1Pfct2
-
subroutine sub4(a,b,c)
character(*), intent(inout) :: c(:)
character(*), intent(in) :: a(:), b(:)
diff --git a/flang/test/Semantics/elemental01.f90 b/flang/test/Semantics/elemental01.f90
index 6b2b25907ef60..f0e501e9d8311 100644
--- a/flang/test/Semantics/elemental01.f90
+++ b/flang/test/Semantics/elemental01.f90
@@ -47,3 +47,41 @@ elemental function ptrf(n)
!ERROR: The result of an ELEMENTAL function may not be a POINTER
real, pointer :: ptrf
end function
+
+module m
+ integer modvar
+ type t
+ character(:), allocatable :: c
+ end type
+ type pdt(L)
+ integer, len :: L
+ end type
+ type container
+ class(pdt(:)), allocatable :: c
+ end type
+ contains
+ !ERROR: Invalid specification expression for elemental function result: dependence on value of dummy argument 'n'
+ elemental character(n) function bad1(n)
+ integer, intent(in) :: n
+ end
+ !ERROR: Invalid specification expression for elemental function result: non-constant inquiry function 'len' not allowed for local object
+ elemental character(x%c%len) function bad2(x)
+ type(t), intent(in) :: x
+ end
+ !ERROR: Invalid specification expression for elemental function result: non-constant type parameter inquiry not allowed for local object
+ elemental character(x%c%L) function bad3(x)
+ class(container), intent(in) :: x
+ end
+ elemental character(len(x)) function ok1(x) ! ok
+ character(*), intent(in) :: x
+ end
+ elemental character(modvar) function ok2(x) ! ok
+ character(*), intent(in) :: x
+ end
+ elemental character(len(x)) function ok3(x) ! ok
+ character(modvar), intent(in) :: x
+ end
+ elemental character(storage_size(x)) function ok4(x) ! ok
+ class(*), intent(in) :: x
+ end
+end
More information about the flang-commits
mailing list