Eugene Epshteyn
d1ad52f0ca
Audit of every #include directive in flang/lib/ and flang/include/flang/: - Remove 423 #include directives (293 from lib/ translation units, 23 from lib-private headers, 107 from public headers) that are not needed: no entity declared by the removed header is used - directly or in any conditional-compilation branch (Windows, macOS, ARM/PowerPC, REAL(16)/REAL(2) configuration macros) - in the including file, and for headers no consumer in flang/lib, flang/tools, flang/unittests, or flang-rt relies on the include as a re-export. Load-bearing includes were examined and retained: textual .inc/.def expansions, tablegen pass-header declaration/definition pairings, dialect headers carrying generated-op interface dependencies, config-macro providers (e.g. float128.h ahead of matmul-instances.inc guards), and ADL formatting machinery (Evaluate/formatting.h). - Add 5 missing direct #includes in lib translation units that used entities only via now-removed transitive includes, and drop one vestigial 'using namespace Fortran::runtime;' whose declaring header no longer arrives transitively (nothing namespace-qualified from it was used), per the include rules in flang/docs/C++style.md. Assisted-by: AI
382 lines
14 KiB
C++
382 lines
14 KiB
C++
//===-- lib/Semantics/check-case.cpp --------------------------------------===//
|
|
//
|
|
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
|
|
// See https://llvm.org/LICENSE.txt for license information.
|
|
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
|
|
//
|
|
//===----------------------------------------------------------------------===//
|
|
|
|
#include "check-case.h"
|
|
#include "flang/Common/idioms.h"
|
|
#include "flang/Common/template.h"
|
|
#include "flang/Evaluate/fold.h"
|
|
#include "flang/Evaluate/tools.h"
|
|
#include "flang/Evaluate/type.h"
|
|
#include "flang/Parser/parse-tree-visitor.h"
|
|
#include "flang/Parser/parse-tree.h"
|
|
#include "flang/Semantics/semantics.h"
|
|
#include "flang/Semantics/tools.h"
|
|
#include <tuple>
|
|
|
|
namespace Fortran::semantics {
|
|
|
|
template <typename T> class CaseValues {
|
|
public:
|
|
CaseValues(SemanticsContext &c, const evaluate::DynamicType &t)
|
|
: context_{c}, caseExprType_{t} {}
|
|
|
|
void Check(const std::list<parser::CaseConstruct::Case> &cases) {
|
|
for (const parser::CaseConstruct::Case &c : cases) {
|
|
AddCase(c);
|
|
}
|
|
if (!hasErrors_) {
|
|
cases_.sort(Comparator{});
|
|
if (!AreCasesDisjoint()) { // C1149
|
|
ReportConflictingCases();
|
|
}
|
|
}
|
|
}
|
|
|
|
private:
|
|
using Value = evaluate::Scalar<T>;
|
|
|
|
void AddCase(const parser::CaseConstruct::Case &c) {
|
|
const auto &stmt{std::get<parser::Statement<parser::CaseStmt>>(c.t)};
|
|
const parser::CaseStmt &caseStmt{stmt.statement};
|
|
const auto &selector{std::get<parser::CaseSelector>(caseStmt.t)};
|
|
common::visit(
|
|
common::visitors{
|
|
[&](const std::list<parser::CaseValueRange> &ranges) {
|
|
for (const auto &range : ranges) {
|
|
auto pair{ComputeBounds(range)};
|
|
if (pair.first && pair.second && *pair.first > *pair.second) {
|
|
context_.Warn(common::UsageWarning::EmptyCase, stmt.source,
|
|
"CASE has lower bound greater than upper bound"_warn_en_US);
|
|
} else {
|
|
if constexpr (T::category == TypeCategory::Logical) { // C1148
|
|
if ((pair.first || pair.second) &&
|
|
(!pair.first || !pair.second ||
|
|
*pair.first != *pair.second)) {
|
|
context_.Say(stmt.source,
|
|
"CASE range is not allowed for LOGICAL"_err_en_US);
|
|
}
|
|
}
|
|
cases_.emplace_back(stmt);
|
|
cases_.back().lower = std::move(pair.first);
|
|
cases_.back().upper = std::move(pair.second);
|
|
}
|
|
}
|
|
},
|
|
[&](const parser::Default &) { cases_.emplace_front(stmt); },
|
|
},
|
|
selector.u);
|
|
}
|
|
|
|
std::optional<Value> GetValue(const parser::CaseValue &caseValue) {
|
|
const auto &expr{parser::UnwrapRef<parser::Expr>(caseValue)};
|
|
auto *x{expr.typedExpr.get()};
|
|
if (x && x->v) { // C1147
|
|
auto type{x->v->GetType()};
|
|
if (type && type->category() == caseExprType_.category() &&
|
|
(type->category() != TypeCategory::Character ||
|
|
type->kind() == caseExprType_.kind())) {
|
|
parser::Messages buffer; // discarded folding messages
|
|
parser::ContextualMessages foldingMessages{expr.source, &buffer};
|
|
evaluate::FoldingContext foldingContext{
|
|
context_.foldingContext(), foldingMessages};
|
|
auto folded{evaluate::Fold(foldingContext, SomeExpr{*x->v})};
|
|
if (auto converted{evaluate::Fold(foldingContext,
|
|
evaluate::ConvertToType(T::GetType(), SomeExpr{folded}))}) {
|
|
if (auto value{evaluate::GetScalarConstantValue<T>(*converted)}) {
|
|
auto back{evaluate::Fold(foldingContext,
|
|
evaluate::ConvertToType(*type, SomeExpr{*converted}))};
|
|
if (back == folded) {
|
|
x->v = converted;
|
|
return value;
|
|
} else {
|
|
context_.Warn(common::UsageWarning::CaseOverflow, expr.source,
|
|
"CASE value (%s) overflows type (%s) of SELECT CASE expression"_warn_en_US,
|
|
folded.AsFortran(), caseExprType_.AsFortran());
|
|
hasErrors_ = true;
|
|
return std::nullopt;
|
|
}
|
|
}
|
|
}
|
|
context_.Say(expr.source,
|
|
"CASE value (%s) must be a constant scalar"_err_en_US,
|
|
x->v->AsFortran());
|
|
} else {
|
|
std::string typeStr{type ? type->AsFortran() : "typeless"s};
|
|
context_.Say(expr.source,
|
|
"CASE value has type '%s' which is not compatible with the SELECT CASE expression's type '%s'"_err_en_US,
|
|
typeStr, caseExprType_.AsFortran());
|
|
}
|
|
hasErrors_ = true;
|
|
}
|
|
return std::nullopt;
|
|
}
|
|
|
|
using PairOfValues = std::pair<std::optional<Value>, std::optional<Value>>;
|
|
PairOfValues ComputeBounds(const parser::CaseValueRange &range) {
|
|
return common::visit(common::visitors{
|
|
[&](const parser::CaseValue &x) {
|
|
auto value{GetValue(x)};
|
|
return PairOfValues{value, value};
|
|
},
|
|
[&](const parser::CaseValueRange::Range &x) {
|
|
const auto &[lower, upper]{x.t};
|
|
std::optional<Value> lo, hi;
|
|
if (lower) {
|
|
lo = GetValue(*lower);
|
|
}
|
|
if (upper) {
|
|
hi = GetValue(*upper);
|
|
}
|
|
if ((lower && !lo) || (upper && !hi)) {
|
|
return PairOfValues{}; // error case
|
|
}
|
|
return PairOfValues{
|
|
std::move(lo), std::move(hi)};
|
|
},
|
|
},
|
|
range.u);
|
|
}
|
|
|
|
struct Case {
|
|
explicit Case(const parser::Statement<parser::CaseStmt> &s) : stmt{s} {}
|
|
bool IsDefault() const { return !lower && !upper; }
|
|
std::string AsFortran() const {
|
|
std::string result;
|
|
{
|
|
llvm::raw_string_ostream bs{result};
|
|
if (lower) {
|
|
evaluate::Constant<T>{*lower}.AsFortran(bs << '(');
|
|
if (!upper) {
|
|
bs << ':';
|
|
} else if (*lower != *upper) {
|
|
evaluate::Constant<T>{*upper}.AsFortran(bs << ':');
|
|
}
|
|
bs << ')';
|
|
} else if (upper) {
|
|
evaluate::Constant<T>{*upper}.AsFortran(bs << "(:") << ')';
|
|
} else {
|
|
bs << "DEFAULT";
|
|
}
|
|
}
|
|
return result;
|
|
}
|
|
|
|
const parser::Statement<parser::CaseStmt> &stmt;
|
|
std::optional<Value> lower, upper;
|
|
};
|
|
|
|
// Defines a comparator for use with std::list<>::sort().
|
|
// Returns true if and only if the highest value in range x is less
|
|
// than the least value in range y. The DEFAULT case is arbitrarily
|
|
// defined to be less than all others. When two ranges overlap,
|
|
// neither is less than the other.
|
|
struct Comparator {
|
|
bool operator()(const Case &x, const Case &y) const {
|
|
if (x.IsDefault()) {
|
|
return !y.IsDefault();
|
|
} else {
|
|
return x.upper && y.lower && *x.upper < *y.lower;
|
|
}
|
|
}
|
|
};
|
|
|
|
bool AreCasesDisjoint() const {
|
|
auto endIter{cases_.end()};
|
|
for (auto iter{cases_.begin()}; iter != endIter; ++iter) {
|
|
auto next{iter};
|
|
if (++next != endIter && !Comparator{}(*iter, *next)) {
|
|
return false;
|
|
}
|
|
}
|
|
return true;
|
|
}
|
|
|
|
// This has quadratic time, but only runs in error cases
|
|
void ReportConflictingCases() {
|
|
for (auto iter{cases_.begin()}; iter != cases_.end(); ++iter) {
|
|
parser::Message *msg{nullptr};
|
|
for (auto p{cases_.begin()}; p != cases_.end(); ++p) {
|
|
if (p->stmt.source.begin() < iter->stmt.source.begin() &&
|
|
!Comparator{}(*p, *iter) && !Comparator{}(*iter, *p)) {
|
|
if (!msg) {
|
|
msg = &context_.Say(iter->stmt.source,
|
|
"CASE %s conflicts with previous cases"_err_en_US,
|
|
iter->AsFortran());
|
|
}
|
|
msg->Attach(
|
|
p->stmt.source, "Conflicting CASE %s"_en_US, p->AsFortran());
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
SemanticsContext &context_;
|
|
const evaluate::DynamicType &caseExprType_;
|
|
std::list<Case> cases_;
|
|
bool hasErrors_{false};
|
|
};
|
|
|
|
template <TypeCategory CAT> struct TypeVisitor {
|
|
using Result = bool;
|
|
using Types = evaluate::CategoryTypes<CAT>;
|
|
template <typename T> Result Test() {
|
|
if (T::kind == exprType.kind()) {
|
|
CaseValues<T>(context, exprType).Check(caseList);
|
|
return true;
|
|
} else {
|
|
return false;
|
|
}
|
|
}
|
|
SemanticsContext &context;
|
|
const evaluate::DynamicType &exprType;
|
|
const std::list<parser::CaseConstruct::Case> &caseList;
|
|
};
|
|
|
|
// Convert a single enumeration CASE value to its __ordinal integer.
|
|
static bool ConvertEnumCaseValue(SemanticsContext &context,
|
|
const parser::CaseValue &caseValue,
|
|
const semantics::DerivedTypeSpec &enumType,
|
|
const semantics::Symbol &ordSym) {
|
|
const auto &expr{parser::UnwrapRef<parser::Expr>(caseValue)};
|
|
auto *x{expr.typedExpr.get()};
|
|
if (!x || !x->v) {
|
|
return false;
|
|
}
|
|
auto type{x->v->GetType()};
|
|
if (!type || type->category() != TypeCategory::Derived) {
|
|
std::string typeStr{type ? type->AsFortran() : "typeless"s};
|
|
context.Say(expr.source,
|
|
"CASE value has type '%s' which is not compatible with the SELECT CASE expression's type '%s'"_err_en_US,
|
|
typeStr, enumType.AsFortran());
|
|
return false;
|
|
}
|
|
const auto *caseDerived{evaluate::GetDerivedTypeSpec(*type)};
|
|
if (!caseDerived || !caseDerived->IsEnumerationType() ||
|
|
&caseDerived->typeSymbol() != &enumType.typeSymbol()) {
|
|
context.Say(expr.source,
|
|
"CASE value has type '%s' which is not compatible with the SELECT CASE expression's type '%s'"_err_en_US,
|
|
type->AsFortran(), enumType.AsFortran());
|
|
return false;
|
|
}
|
|
// Extract the ordinal integer from the constant enum value
|
|
parser::Messages buffer;
|
|
parser::ContextualMessages foldingMessages{expr.source, &buffer};
|
|
evaluate::FoldingContext foldingContext{
|
|
context.foldingContext(), foldingMessages};
|
|
auto folded{evaluate::Fold(foldingContext, SomeExpr{*x->v})};
|
|
if (auto sc{
|
|
evaluate::GetScalarConstantValue<evaluate::SomeDerived>(folded)}) {
|
|
if (auto ordExpr{sc->Find(ordSym)}) {
|
|
x->v = std::move(*ordExpr);
|
|
return true;
|
|
}
|
|
}
|
|
context.Say(expr.source,
|
|
"CASE value (%s) must be a constant scalar"_err_en_US, x->v->AsFortran());
|
|
return false;
|
|
}
|
|
|
|
// A parse-tree visitor that converts every enumeration CASE value it
|
|
// encounters to its ordinal integer value, recording whether all
|
|
// conversions succeeded.
|
|
struct EnumCaseValueConverter {
|
|
template <typename A> bool Pre(const A &) { return true; }
|
|
template <typename A> void Post(const A &) {}
|
|
bool Pre(const parser::CaseValue &val) {
|
|
if (!ConvertEnumCaseValue(context, val, enumType, ordSym)) {
|
|
ok = false;
|
|
}
|
|
return false;
|
|
}
|
|
SemanticsContext &context;
|
|
const semantics::DerivedTypeSpec &enumType;
|
|
const semantics::Symbol &ordSym;
|
|
bool ok{true};
|
|
};
|
|
|
|
// Walk all CASE values in an enumeration SELECT CASE, check type
|
|
// compatibility, and convert each to its ordinal integer value.
|
|
static bool ConvertEnumCaseValues(SemanticsContext &context,
|
|
const std::list<parser::CaseConstruct::Case> &cases,
|
|
const semantics::DerivedTypeSpec &enumType) {
|
|
const auto *scope{enumType.GetScope()};
|
|
if (!scope) {
|
|
return false;
|
|
}
|
|
auto ordIter{scope->find(
|
|
semantics::SourceName{semantics::DerivedTypeDetails::ordinalComponentName,
|
|
sizeof(semantics::DerivedTypeDetails::ordinalComponentName) - 1})};
|
|
if (ordIter == scope->end()) {
|
|
return false;
|
|
}
|
|
const semantics::Symbol &ordSym{*ordIter->second};
|
|
EnumCaseValueConverter visitor{context, enumType, ordSym};
|
|
// Walk only each case's CaseStmt so that the conversion never descends
|
|
// into an arm's body, where a nested SELECT CASE could otherwise have its
|
|
// own CASE values converted against this enumeration type.
|
|
for (const auto &c : cases) {
|
|
const auto &stmt{std::get<parser::Statement<parser::CaseStmt>>(c.t)};
|
|
parser::Walk(stmt.statement, visitor);
|
|
}
|
|
return visitor.ok;
|
|
}
|
|
|
|
void CaseChecker::Enter(const parser::CaseConstruct &construct) {
|
|
const auto &selectCaseStmt{
|
|
std::get<parser::Statement<parser::SelectCaseStmt>>(construct.t)};
|
|
const auto &selectCase{selectCaseStmt.statement};
|
|
const auto &selectExpr{
|
|
std::get<parser::Scalar<parser::Expr>>(selectCase.t).thing};
|
|
const auto *x{GetExpr(context_, selectExpr)};
|
|
if (!x) {
|
|
return; // expression semantics failed
|
|
}
|
|
if (auto exprType{x->GetType()}) {
|
|
const auto &caseList{
|
|
std::get<std::list<parser::CaseConstruct::Case>>(construct.t)};
|
|
switch (exprType->category()) {
|
|
case TypeCategory::Integer:
|
|
common::SearchTypes(
|
|
TypeVisitor<TypeCategory::Integer>{context_, *exprType, caseList});
|
|
return;
|
|
case TypeCategory::Unsigned:
|
|
common::SearchTypes(
|
|
TypeVisitor<TypeCategory::Unsigned>{context_, *exprType, caseList});
|
|
return;
|
|
case TypeCategory::Logical:
|
|
CaseValues<evaluate::Type<TypeCategory::Logical, 1>>{context_, *exprType}
|
|
.Check(caseList);
|
|
return;
|
|
case TypeCategory::Character:
|
|
common::SearchTypes(
|
|
TypeVisitor<TypeCategory::Character>{context_, *exprType, caseList});
|
|
return;
|
|
case TypeCategory::Derived:
|
|
if (const auto *derived{evaluate::GetDerivedTypeSpec(*exprType)}) {
|
|
if (derived->IsEnumerationType()) {
|
|
if (ConvertEnumCaseValues(context_, caseList, *derived)) {
|
|
evaluate::DynamicType intType{TypeCategory::Integer, 4};
|
|
CaseValues<evaluate::Type<TypeCategory::Integer, 4>>{
|
|
context_, intType}
|
|
.Check(caseList);
|
|
}
|
|
return;
|
|
}
|
|
}
|
|
break;
|
|
default:
|
|
break;
|
|
}
|
|
}
|
|
context_.Say(selectExpr.source,
|
|
context_.IsEnabled(common::LanguageFeature::Unsigned)
|
|
? "SELECT CASE expression must be integer, unsigned, logical, character, or enumeration type"_err_en_US
|
|
: "SELECT CASE expression must be integer, logical, character, or enumeration type"_err_en_US);
|
|
}
|
|
} // namespace Fortran::semantics
|