llvm-project
129 строк · 4.9 Кб
1//===-- lib/Semantics/check-select-rank.cpp -------------------------------===//
2//
3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4// See https://llvm.org/LICENSE.txt for license information.
5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6//
7//===----------------------------------------------------------------------===//
8
9#include "check-select-rank.h"10#include "flang/Common/Fortran.h"11#include "flang/Common/idioms.h"12#include "flang/Parser/message.h"13#include "flang/Parser/tools.h"14#include "flang/Semantics/tools.h"15#include <list>16#include <optional>17#include <set>18#include <tuple>19#include <variant>20
21namespace Fortran::semantics {22
23void SelectRankConstructChecker::Leave(24const parser::SelectRankConstruct &selectRankConstruct) {25const auto &selectRankStmt{26std::get<parser::Statement<parser::SelectRankStmt>>(27selectRankConstruct.t)};28const auto &selectRankStmtSel{29std::get<parser::Selector>(selectRankStmt.statement.t)};30
31// R1149 select-rank-stmt checks32const Symbol *saveSelSymbol{nullptr};33if (const auto selExpr{GetExprFromSelector(selectRankStmtSel)}) {34if (const Symbol * sel{evaluate::UnwrapWholeSymbolDataRef(*selExpr)}) {35if (!evaluate::IsAssumedRank(*sel)) { // C115036context_.Say(parser::FindSourceLocation(selectRankStmtSel),37"Selector '%s' is not an assumed-rank array variable"_err_en_US,38sel->name().ToString());39} else {40saveSelSymbol = sel;41}42} else {43context_.Say(parser::FindSourceLocation(selectRankStmtSel),44"Selector '%s' is not an assumed-rank array variable"_err_en_US,45parser::FindSourceLocation(selectRankStmtSel).ToString());46}47}48
49// R1150 select-rank-case-stmt checks50auto &rankCaseList{std::get<std::list<parser::SelectRankConstruct::RankCase>>(51selectRankConstruct.t)};52bool defaultRankFound{false};53bool starRankFound{false};54parser::CharBlock prevLocDefault;55parser::CharBlock prevLocStar;56std::optional<parser::CharBlock> caseForRank[common::maxRank + 1];57
58for (const auto &rankCase : rankCaseList) {59const auto &rankCaseStmt{60std::get<parser::Statement<parser::SelectRankCaseStmt>>(rankCase.t)};61const auto &rank{62std::get<parser::SelectRankCaseStmt::Rank>(rankCaseStmt.statement.t)};63common::visit(64common::visitors{65[&](const parser::Default &) { // C115366if (!defaultRankFound) {67defaultRankFound = true;68prevLocDefault = rankCaseStmt.source;69} else {70context_
71.Say(rankCaseStmt.source,72"Not more than one of the selectors of SELECT RANK "73"statement may be DEFAULT"_err_en_US)74.Attach(prevLocDefault, "Previous use"_en_US);75}76},77[&](const parser::Star &) { // C115378if (!starRankFound) {79starRankFound = true;80prevLocStar = rankCaseStmt.source;81} else {82context_
83.Say(rankCaseStmt.source,84"Not more than one of the selectors of SELECT RANK "85"statement may be '*'"_err_en_US)86.Attach(prevLocStar, "Previous use"_en_US);87}88if (saveSelSymbol &&89IsAllocatableOrPointer(*saveSelSymbol)) { // F'2023 C116090context_.Say(rankCaseStmt.source,91"RANK (*) cannot be used when selector is "92"POINTER or ALLOCATABLE"_err_en_US);93}94},95[&](const parser::ScalarIntConstantExpr &init) {96if (auto val{GetIntValue(init)}) {97// If value is in valid range, then only show98// value repeat error, else stack smashing occurs99if (*val < 0 || *val > common::maxRank) { // C1151100context_.Say(rankCaseStmt.source,101"The value of the selector must be "102"between zero and %d"_err_en_US,103common::maxRank);104
105} else {106if (!caseForRank[*val].has_value()) {107caseForRank[*val] = rankCaseStmt.source;108} else {109auto prevloc{caseForRank[*val].value()};110context_
111.Say(rankCaseStmt.source,112"Same rank value (%d) not allowed more than once"_err_en_US,113*val)114.Attach(prevloc, "Previous use"_en_US);115}116}117}118},119},120rank.u);121}122}
123
124const SomeExpr *SelectRankConstructChecker::GetExprFromSelector(125const parser::Selector &selector) {126return common::visit([](const auto &x) { return GetExpr(x); }, selector.u);127}
128
129} // namespace Fortran::semantics130