Skip to content

Commit 67081ba

Browse files
klauslerklausler
authored
[flang] Enforce F'2023 C15121 (#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.
1 parent d9012d8 commit 67081ba

File tree

5 files changed

+175
-119
lines changed

5 files changed

+175
-119
lines changed

‎flang/include/flang/Evaluate/check-expression.h

Lines changed: 13 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -77,23 +77,26 @@ std::optional<Expr<SomeType>> NonPointerInitializationExpr(const Symbol &,
7777
// specification expressions.
7878

7979
template <typename A>
80-
void CheckSpecificationExpr(
81-
const A &, const semantics::Scope &, FoldingContext &);
82-
extern template void CheckSpecificationExpr(
83-
const Expr<SomeType> &x, const semantics::Scope &, FoldingContext &);
84-
extern template void CheckSpecificationExpr(
85-
const Expr<SomeInteger> &x, const semantics::Scope &, FoldingContext &);
80+
void CheckSpecificationExpr(const A &, const semantics::Scope &,
81+
FoldingContext &, bool forElementalFunctionResult);
82+
extern template void CheckSpecificationExpr(const Expr<SomeType> &x,
83+
const semantics::Scope &, FoldingContext &,
84+
bool forElementalFunctionResult);
85+
extern template void CheckSpecificationExpr(const Expr<SomeInteger> &x,
86+
const semantics::Scope &, FoldingContext &,
87+
bool forElementalFunctionResult);
8688
extern template void CheckSpecificationExpr(const Expr<SubscriptInteger> &x,
87-
const semantics::Scope &, FoldingContext &);
89+
const semantics::Scope &, FoldingContext &,
90+
bool forElementalFunctionResult);
8891
extern template void CheckSpecificationExpr(
8992
const std::optional<Expr<SomeType>> &x, const semantics::Scope &,
90-
FoldingContext &);
93+
FoldingContext &, bool forElementalFunctionResult);
9194
extern template void CheckSpecificationExpr(
9295
const std::optional<Expr<SomeInteger>> &x, const semantics::Scope &,
93-
FoldingContext &);
96+
FoldingContext &, bool forElementalFunctionResult);
9497
extern template void CheckSpecificationExpr(
9598
const std::optional<Expr<SubscriptInteger>> &x, const semantics::Scope &,
96-
FoldingContext &);
99+
FoldingContext &, bool forElementalFunctionResult);
97100

98101
// Contiguity & "simple contiguity" (9.5.4)
99102
template <typename A>

‎flang/lib/Evaluate/check-expression.cpp

Lines changed: 95 additions & 66 deletions
Original file line numberDiff line numberDiff line change
@@ -507,53 +507,17 @@ std::optional<Expr<SomeType>> NonPointerInitializationExpr(const Symbol &symbol,
507507
return std::nullopt;
508508
}
509509

510-
static bool IsNonLocal(const semantics::Symbol &symbol) {
511-
return semantics::IsDummy(symbol) || symbol.has<semantics::UseDetails>() ||
512-
symbol.owner().kind() == semantics::Scope::Kind::Module ||
513-
semantics::FindCommonBlockContaining(symbol) ||
514-
symbol.has<semantics::HostAssocDetails>();
515-
}
516-
517-
static bool IsPermissibleInquiry(const semantics::Symbol &firstSymbol,
518-
const semantics::Symbol &lastSymbol, DescriptorInquiry::Field field,
519-
const semantics::Scope &localScope) {
520-
if (IsNonLocal(firstSymbol)) {
521-
return true;
522-
}
523-
if (&localScope != &firstSymbol.owner()) {
524-
return true;
525-
}
526-
// Inquiries on local objects may not access a deferred bound or length.
527-
// (This code used to be a switch, but it proved impossible to write it
528-
// thus without running afoul of bogus warnings from different C++
529-
// compilers.)
530-
if (field == DescriptorInquiry::Field::Rank) {
531-
return true; // always known
532-
}
533-
const auto *object{lastSymbol.detailsIf<semantics::ObjectEntityDetails>()};
534-
if (field == DescriptorInquiry::Field::LowerBound ||
535-
field == DescriptorInquiry::Field::Extent ||
536-
field == DescriptorInquiry::Field::Stride) {
537-
return object && !object->shape().CanBeDeferredShape();
538-
}
539-
if (field == DescriptorInquiry::Field::Len) {
540-
return object && object->type() &&
541-
object->type()->category() == semantics::DeclTypeSpec::Character &&
542-
!object->type()->characterTypeSpec().length().isDeferred();
543-
}
544-
return false;
545-
}
546-
547510
// Specification expression validation (10.1.11(2), C1010)
548511
class CheckSpecificationExprHelper
549512
: public AnyTraverse<CheckSpecificationExprHelper,
550513
std::optional<std::string>> {
551514
public:
552515
using Result = std::optional<std::string>;
553516
using Base = AnyTraverse<CheckSpecificationExprHelper, Result>;
554-
explicit CheckSpecificationExprHelper(
555-
const semantics::Scope &s, FoldingContext &context)
556-
: Base{*this}, scope_{s}, context_{context} {}
517+
explicit CheckSpecificationExprHelper(const semantics::Scope &s,
518+
FoldingContext &context, bool forElementalFunctionResult)
519+
: Base{*this}, scope_{s}, context_{context},
520+
forElementalFunctionResult_{forElementalFunctionResult} {}
557521
using Base::operator();
558522

559523
Result operator()(const CoarrayRef &) const { return "coindexed reference"; }
@@ -572,7 +536,10 @@ class CheckSpecificationExprHelper
572536
"reference variable '"s +
573537
ultimate.name().ToString() + "'";
574538
} else if (IsDummy(ultimate)) {
575-
if (ultimate.attrs().test(semantics::Attr::OPTIONAL)) {
539+
if (!inInquiry_ && forElementalFunctionResult_) {
540+
return "dependence on value of dummy argument '"s +
541+
ultimate.name().ToString() + "'";
542+
} else if (ultimate.attrs().test(semantics::Attr::OPTIONAL)) {
576543
return "reference to OPTIONAL dummy argument '"s +
577544
ultimate.name().ToString() + "'";
578545
} else if (!inInquiry_ &&
@@ -629,8 +596,8 @@ class CheckSpecificationExprHelper
629596
// expressions will have been converted to expressions over descriptor
630597
// inquiries by Fold().
631598
// Catch REAL, ALLOCATABLE :: X(:); REAL :: Y(SIZE(X))
632-
if (IsPermissibleInquiry(x.base().GetFirstSymbol(),
633-
x.base().GetLastSymbol(), x.field(), scope_)) {
599+
if (IsPermissibleInquiry(
600+
x.base().GetFirstSymbol(), x.base().GetLastSymbol(), x.field())) {
634601
auto restorer{common::ScopedSet(inInquiry_, true)};
635602
return (*this)(x.base());
636603
} else if (IsConstantExpr(x)) {
@@ -641,10 +608,18 @@ class CheckSpecificationExprHelper
641608
}
642609

643610
Result operator()(const TypeParamInquiry &inq) const {
644-
if (scope_.IsDerivedType() && !IsConstantExpr(inq) &&
645-
inq.base() /* X%T, not local T */) { // C750, C754
646-
return "non-constant reference to a type parameter inquiry not "
647-
"allowed for derived type components or type parameter values";
611+
if (scope_.IsDerivedType()) {
612+
if (!IsConstantExpr(inq) &&
613+
inq.base() /* X%T, not local T */) { // C750, C754
614+
return "non-constant reference to a type parameter inquiry not allowed "
615+
"for derived type components or type parameter values";
616+
}
617+
} else if (inq.base() &&
618+
IsInquiryAlwaysPermissible(inq.base()->GetFirstSymbol())) {
619+
auto restorer{common::ScopedSet(inInquiry_, true)};
620+
return (*this)(inq.base());
621+
} else if (!IsConstantExpr(inq)) {
622+
return "non-constant type parameter inquiry not allowed for local object";
648623
}
649624
return std::nullopt;
650625
}
@@ -719,19 +694,19 @@ class CheckSpecificationExprHelper
719694
intrin.name == "is_contiguous") { // ok
720695
} else if (intrin.name == "len" &&
721696
IsPermissibleInquiry(dataRef->GetFirstSymbol(),
722-
dataRef->GetLastSymbol(), DescriptorInquiry::Field::Len,
723-
scope_)) { // ok
697+
dataRef->GetLastSymbol(),
698+
DescriptorInquiry::Field::Len)) { // ok
724699
} else if (intrin.name == "lbound" &&
725700
IsPermissibleInquiry(dataRef->GetFirstSymbol(),
726701
dataRef->GetLastSymbol(),
727-
DescriptorInquiry::Field::LowerBound, scope_)) { // ok
702+
DescriptorInquiry::Field::LowerBound)) { // ok
728703
} else if ((intrin.name == "shape" || intrin.name == "size" ||
729704
intrin.name == "sizeof" ||
730705
intrin.name == "storage_size" ||
731706
intrin.name == "ubound") &&
732707
IsPermissibleInquiry(dataRef->GetFirstSymbol(),
733-
dataRef->GetLastSymbol(), DescriptorInquiry::Field::Extent,
734-
scope_)) { // ok
708+
dataRef->GetLastSymbol(),
709+
DescriptorInquiry::Field::Extent)) { // ok
735710
} else {
736711
return "non-constant inquiry function '"s + intrin.name +
737712
"' not allowed for local object";
@@ -750,32 +725,86 @@ class CheckSpecificationExprHelper
750725
// Contextual information: this flag is true when in an argument to
751726
// an inquiry intrinsic like SIZE().
752727
mutable bool inInquiry_{false};
728+
bool forElementalFunctionResult_{false}; // F'2023 C15121
753729
const std::set<std::string> badIntrinsicsForComponents_{
754730
"allocated", "associated", "extends_type_of", "present", "same_type_as"};
731+
732+
bool IsInquiryAlwaysPermissible(const semantics::Symbol &) const;
733+
bool IsPermissibleInquiry(const semantics::Symbol &firstSymbol,
734+
const semantics::Symbol &lastSymbol,
735+
DescriptorInquiry::Field field) const;
755736
};
756737

738+
bool CheckSpecificationExprHelper::IsInquiryAlwaysPermissible(
739+
const semantics::Symbol &symbol) const {
740+
if (&symbol.owner() != &scope_ || symbol.has<semantics::UseDetails>() ||
741+
symbol.owner().kind() == semantics::Scope::Kind::Module ||
742+
semantics::FindCommonBlockContaining(symbol) ||
743+
symbol.has<semantics::HostAssocDetails>()) {
744+
return true; // it's nonlocal
745+
} else if (semantics::IsDummy(symbol) && !forElementalFunctionResult_) {
746+
return true;
747+
} else {
748+
return false;
749+
}
750+
}
751+
752+
bool CheckSpecificationExprHelper::IsPermissibleInquiry(
753+
const semantics::Symbol &firstSymbol, const semantics::Symbol &lastSymbol,
754+
DescriptorInquiry::Field field) const {
755+
if (IsInquiryAlwaysPermissible(firstSymbol)) {
756+
return true;
757+
}
758+
// Inquiries on local objects may not access a deferred bound or length.
759+
// (This code used to be a switch, but it proved impossible to write it
760+
// thus without running afoul of bogus warnings from different C++
761+
// compilers.)
762+
if (field == DescriptorInquiry::Field::Rank) {
763+
return true; // always known
764+
}
765+
const auto *object{lastSymbol.detailsIf<semantics::ObjectEntityDetails>()};
766+
if (field == DescriptorInquiry::Field::LowerBound ||
767+
field == DescriptorInquiry::Field::Extent ||
768+
field == DescriptorInquiry::Field::Stride) {
769+
return object && !object->shape().CanBeDeferredShape();
770+
}
771+
if (field == DescriptorInquiry::Field::Len) {
772+
return object && object->type() &&
773+
object->type()->category() == semantics::DeclTypeSpec::Character &&
774+
!object->type()->characterTypeSpec().length().isDeferred();
775+
}
776+
return false;
777+
}
778+
757779
template <typename A>
758-
void CheckSpecificationExpr(
759-
const A &x, const semantics::Scope &scope, FoldingContext &context) {
760-
if (auto why{CheckSpecificationExprHelper{scope, context}(x)}) {
761-
context.messages().Say(
762-
"Invalid specification expression: %s"_err_en_US, *why);
780+
void CheckSpecificationExpr(const A &x, const semantics::Scope &scope,
781+
FoldingContext &context, bool forElementalFunctionResult) {
782+
if (auto why{CheckSpecificationExprHelper{
783+
scope, context, forElementalFunctionResult}(x)}) {
784+
context.messages().Say("Invalid specification expression%s: %s"_err_en_US,
785+
forElementalFunctionResult ? " for elemental function result" : "",
786+
*why);
763787
}
764788
}
765789

766-
template void CheckSpecificationExpr(
767-
const Expr<SomeType> &, const semantics::Scope &, FoldingContext &);
768-
template void CheckSpecificationExpr(
769-
const Expr<SomeInteger> &, const semantics::Scope &, FoldingContext &);
770-
template void CheckSpecificationExpr(
771-
const Expr<SubscriptInteger> &, const semantics::Scope &, FoldingContext &);
790+
template void CheckSpecificationExpr(const Expr<SomeType> &,
791+
const semantics::Scope &, FoldingContext &,
792+
bool forElementalFunctionResult);
793+
template void CheckSpecificationExpr(const Expr<SomeInteger> &,
794+
const semantics::Scope &, FoldingContext &,
795+
bool forElementalFunctionResult);
796+
template void CheckSpecificationExpr(const Expr<SubscriptInteger> &,
797+
const semantics::Scope &, FoldingContext &,
798+
bool forElementalFunctionResult);
772799
template void CheckSpecificationExpr(const std::optional<Expr<SomeType>> &,
773-
const semantics::Scope &, FoldingContext &);
800+
const semantics::Scope &, FoldingContext &,
801+
bool forElementalFunctionResult);
774802
template void CheckSpecificationExpr(const std::optional<Expr<SomeInteger>> &,
775-
const semantics::Scope &, FoldingContext &);
803+
const semantics::Scope &, FoldingContext &,
804+
bool forElementalFunctionResult);
776805
template void CheckSpecificationExpr(
777806
const std::optional<Expr<SubscriptInteger>> &, const semantics::Scope &,
778-
FoldingContext &);
807+
FoldingContext &, bool forElementalFunctionResult);
779808

780809
// IsContiguous() -- 9.5.4
781810
class IsContiguousHelper

‎flang/lib/Semantics/check-declarations.cpp

Lines changed: 29 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -40,7 +40,9 @@ class CheckHelper {
4040
SemanticsContext &context() { return context_; }
4141
void Check() { Check(context_.globalScope()); }
4242
void Check(const ParamValue &, bool canBeAssumed);
43-
void Check(const Bound &bound) { CheckSpecExpr(bound.GetExplicit()); }
43+
void Check(const Bound &bound) {
44+
CheckSpecExpr(bound.GetExplicit(), /*forElementalFunctionResult=*/false);
45+
}
4446
void Check(const ShapeSpec &spec) {
4547
Check(spec.lbound());
4648
Check(spec.ubound());
@@ -53,8 +55,10 @@ class CheckHelper {
5355
const Procedure *Characterize(const Symbol &);
5456

5557
private:
56-
template <typename A> void CheckSpecExpr(const A &x) {
57-
evaluate::CheckSpecificationExpr(x, DEREF(scope_), foldingContext_);
58+
template <typename A>
59+
void CheckSpecExpr(const A &x, bool forElementalFunctionResult) {
60+
evaluate::CheckSpecificationExpr(
61+
x, DEREF(scope_), foldingContext_, forElementalFunctionResult);
5862
}
5963
void CheckValue(const Symbol &, const DerivedTypeSpec *);
6064
void CheckVolatile(const Symbol &, const DerivedTypeSpec *);
@@ -222,7 +226,7 @@ void CheckHelper::Check(const ParamValue &value, bool canBeAssumed) {
222226
"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);
223227
}
224228
} else {
225-
CheckSpecExpr(value.GetExplicit());
229+
CheckSpecExpr(value.GetExplicit(), /*forElementalFunctionResult=*/false);
226230
}
227231
}
228232

@@ -378,24 +382,31 @@ void CheckHelper::Check(const Symbol &symbol) {
378382
} else {
379383
Check(*type, canHaveAssumedParameter);
380384
}
381-
if (InPure() && InFunction() && IsFunctionResult(symbol)) {
382-
if (type->IsPolymorphic() && IsAllocatable(symbol)) { // C1585
383-
messages_.Say(
384-
"Result of pure function may not be both polymorphic and ALLOCATABLE"_err_en_US);
385-
}
386-
if (derived) {
387-
// These cases would be caught be the general validation of local
388-
// variables in a pure context, but these messages are more specific.
389-
if (HasImpureFinal(symbol)) { // C1584
385+
if (InFunction() && IsFunctionResult(symbol)) {
386+
if (InPure()) {
387+
if (type->IsPolymorphic() && IsAllocatable(symbol)) { // C1585
390388
messages_.Say(
391-
"Result of pure function may not have an impure FINAL subroutine"_err_en_US);
389+
"Result of pure function may not be both polymorphic and ALLOCATABLE"_err_en_US);
392390
}
393-
if (auto bad{FindPolymorphicAllocatableUltimateComponent(*derived)}) {
394-
SayWithDeclaration(*bad,
395-
"Result of pure function may not have polymorphic ALLOCATABLE ultimate component '%s'"_err_en_US,
396-
bad.BuildResultDesignatorName());
391+
if (derived) {
392+
// These cases would be caught be the general validation of local
393+
// variables in a pure context, but these messages are more specific.
394+
if (HasImpureFinal(symbol)) { // C1584
395+
messages_.Say(
396+
"Result of pure function may not have an impure FINAL subroutine"_err_en_US);
397+
}
398+
if (auto bad{FindPolymorphicAllocatableUltimateComponent(*derived)}) {
399+
SayWithDeclaration(*bad,
400+
"Result of pure function may not have polymorphic ALLOCATABLE ultimate component '%s'"_err_en_US,
401+
bad.BuildResultDesignatorName());
402+
}
397403
}
398404
}
405+
if (InElemental() && isChar) { // F'2023 C15121
406+
CheckSpecExpr(type->characterTypeSpec().length().GetExplicit(),
407+
/*forElementalFunctionResult=*/true);
408+
// TODO: check PDT LEN parameters
409+
}
399410
}
400411
}
401412
if (IsAssumedLengthCharacter(symbol) && IsFunction(symbol)) { // C723

‎flang/test/Lower/HLFIR/elemental-result-length.f90

Lines changed: 0 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -8,12 +8,6 @@ elemental function fct1(a, b) result(t)
88
t = a // b
99
end function
1010

11-
elemental function fct2(c) result(t)
12-
integer, intent(in) :: c
13-
character(c) :: t
14-
15-
end function
16-
1711
subroutine sub2(a,b,c)
1812
character(*), intent(inout) :: c
1913
character(*), intent(in) :: a, b
@@ -42,25 +36,6 @@ subroutine sub2(a,b,c)
4236
! CHECK: %[[RES:.*]] = fir.alloca !fir.char<1,?>(%[[RES_LENGTH]] : index) {bindc_name = ".result"}
4337
! CHECK: fir.call @_QMm1Pfct1
4438

45-
subroutine sub3(c)
46-
character(*), intent(inout) :: c(:)
47-
48-
c = fct2(10)
49-
end subroutine
50-
51-
! CHECK-LABEL: func.func @_QMm1Psub3(
52-
! CHECK-SAME: %[[ARG0:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>> {fir.bindc_name = "c"}) {
53-
! CHECK: %[[C10:.*]] = arith.constant 10 : i32
54-
! 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,?>>>)
55-
! CHECK: %[[ASSOC:.*]]:3 = hlfir.associate %[[C10]] {adapt.valuebyref} : (i32) -> (!fir.ref<i32>, !fir.ref<i32>, i1)
56-
! 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>)
57-
! CHECK: %[[LOAD_INPUT_ARG0:.*]] = fir.load %[[INPUT_ARG0]]#0 : !fir.ref<i32>
58-
! CHECK: %[[LOAD_INPUT_ARG0_IDX:.*]] = fir.convert %[[LOAD_INPUT_ARG0]] : (i32) -> index
59-
! CHECK: %[[CMPI:.*]] = arith.cmpi sgt, %[[LOAD_INPUT_ARG0_IDX]], %c0{{.*}} : index
60-
! CHECK: %[[LENGTH:.*]] = arith.select %[[CMPI]], %[[LOAD_INPUT_ARG0_IDX]], %c0{{.*}} : index
61-
! CHECK: %[[RES:.*]] = fir.alloca !fir.char<1,?>(%[[LENGTH]] : index) {bindc_name = ".result"}
62-
! CHECK: fir.call @_QMm1Pfct2
63-
6439
subroutine sub4(a,b,c)
6540
character(*), intent(inout) :: c(:)
6641
character(*), intent(in) :: a(:), b(:)

0 commit comments

Comments
 (0)