78 lines · cpp
1//===-- lib/Semantics/check-purity.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-exception6//7//===----------------------------------------------------------------------===//8 9#include "check-purity.h"10#include "flang/Parser/parse-tree.h"11#include "flang/Semantics/tools.h"12 13namespace Fortran::semantics {14void PurityChecker::Enter(const parser::ExecutableConstruct &exec) {15 if (InPureSubprogram() && IsImageControlStmt(exec)) {16 context_.Say(GetImageControlStmtLocation(exec),17 "An image control statement may not appear in a pure subprogram"_err_en_US);18 }19}20void PurityChecker::Enter(const parser::SubroutineSubprogram &subr) {21 const auto &stmt{std::get<parser::Statement<parser::SubroutineStmt>>(subr.t)};22 Entered(23 stmt.source, std::get<std::list<parser::PrefixSpec>>(stmt.statement.t));24}25 26void PurityChecker::Leave(const parser::SubroutineSubprogram &) { Left(); }27 28void PurityChecker::Enter(const parser::FunctionSubprogram &func) {29 const auto &stmt{std::get<parser::Statement<parser::FunctionStmt>>(func.t)};30 Entered(31 stmt.source, std::get<std::list<parser::PrefixSpec>>(stmt.statement.t));32}33 34void PurityChecker::Leave(const parser::FunctionSubprogram &func) { Left(); }35 36bool PurityChecker::InPureSubprogram() const {37 return pureDepth_ >= 0 && depth_ >= pureDepth_;38}39 40bool PurityChecker::HasPurePrefix(41 const std::list<parser::PrefixSpec> &prefixes) const {42 bool result{false};43 for (const parser::PrefixSpec &prefix : prefixes) {44 if (std::holds_alternative<parser::PrefixSpec::Impure>(prefix.u)) {45 return false;46 } else if (std::holds_alternative<parser::PrefixSpec::Pure>(prefix.u) ||47 std::holds_alternative<parser::PrefixSpec::Elemental>(prefix.u)) {48 result = true;49 }50 }51 return result;52}53 54void PurityChecker::Entered(55 parser::CharBlock source, const std::list<parser::PrefixSpec> &prefixes) {56 if (depth_ == 2) {57 context_.messages().Say(source,58 "An internal subprogram may not contain an internal subprogram"_err_en_US);59 }60 if (HasPurePrefix(prefixes)) {61 if (pureDepth_ < 0) {62 pureDepth_ = depth_;63 }64 } else if (InPureSubprogram()) {65 context_.messages().Say(source,66 "An internal subprogram of a pure subprogram must also be pure"_err_en_US);67 }68 ++depth_;69}70 71void PurityChecker::Left() {72 if (pureDepth_ == --depth_) {73 pureDepth_ = -1;74 }75}76 77} // namespace Fortran::semantics78