[flang-commits] [flang] [flang] Enforce F'2023 C15121 (PR #94418)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Tue Jun 4 17:57:22 PDT 2024
https://github.com/klausler created https://github.com/llvm/llvm-project/pull/94418
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.
>From d1f5d425fd5bda5f043626d7c0eeb9f6378594e6 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.
---
flang/lib/Semantics/check-declarations.cpp | 60 ++++++++++++++-----
.../Lower/HLFIR/elemental-result-length.f90 | 25 --------
flang/test/Semantics/elemental01.f90 | 25 ++++++++
3 files changed, 71 insertions(+), 39 deletions(-)
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 25de9d4af1ffb..ab47167f3a9b1 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -243,6 +243,31 @@ void CheckHelper::Check(
}
}
+// Checks an elemental function result type parameter specification
+// expression for an unacceptable use of a dummy argument.
+class BadDummyChecker : public evaluate::AnyTraverse<BadDummyChecker, bool> {
+public:
+ using Base = evaluate::AnyTraverse<BadDummyChecker, bool>;
+ BadDummyChecker(parser::ContextualMessages &messages, const Scope &scope)
+ : Base{*this}, messages_{messages}, scope_{scope} {}
+ using Base::operator();
+ bool operator()(const evaluate::DescriptorInquiry &) {
+ return false; // shield base() of inquiry from further checking
+ }
+ bool operator()(const Symbol &symbol) {
+ if (&symbol.owner() == &scope_ && IsDummy(symbol)) {
+ messages_.Say(
+ "Specification expression for elemental function result may not depend on dummy argument '%s''s value"_err_en_US,
+ symbol.name());
+ }
+ return false;
+ }
+
+private:
+ parser::ContextualMessages &messages_;
+ const Scope &scope_;
+};
+
void CheckHelper::Check(const Symbol &symbol) {
if (symbol.name().size() > common::maxNameLen &&
&symbol == &symbol.GetUltimate()) {
@@ -378,24 +403,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
+ BadDummyChecker{messages_, symbol.owner()}(
+ type->characterTypeSpec().length().GetExplicit());
+ // 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..ce7b988e766fa 100644
--- a/flang/test/Semantics/elemental01.f90
+++ b/flang/test/Semantics/elemental01.f90
@@ -47,3 +47,28 @@ 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
+ contains
+ !ERROR: Specification expression for elemental function result may not depend on dummy argument 'n''s value
+ elemental character(n) function bad1(n)
+ integer, intent(in) :: n
+ end
+ !ERROR: Specification expression for elemental function result may not depend on dummy argument 'x''s value
+ elemental character(x%c%len) function bad2(x)
+ type(t), 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
+end
More information about the flang-commits
mailing list