Skip to content

[flang] Enforce F'2023 C15121 #94418

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Jun 12, 2024
Merged

[flang] Enforce F'2023 C15121 #94418

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
23 changes: 13 additions & 10 deletions flang/include/flang/Evaluate/check-expression.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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>
Expand Down
161 changes: 95 additions & 66 deletions flang/lib/Evaluate/check-expression.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -507,53 +507,17 @@ 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,
std::optional<std::string>> {
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"; }
Expand All @@ -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_ &&
Expand Down Expand Up @@ -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)) {
Expand All @@ -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;
}
Expand Down Expand Up @@ -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";
Expand All @@ -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
Expand Down
47 changes: 29 additions & 18 deletions flang/lib/Semantics/check-declarations.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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());
Expand All @@ -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 *);
Expand Down Expand Up @@ -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);
}
}

Expand Down Expand Up @@ -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
Expand Down
25 changes: 0 additions & 25 deletions flang/test/Lower/HLFIR/elemental-result-length.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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(:)
Expand Down
Loading
Loading