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-exception
6//
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 &) { 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 for (const parser::PrefixSpec &prefix : prefixes) {
43 if (std::holds_alternative<parser::PrefixSpec::Pure>(prefix.u)) {
44 return true;
45 }
46 }
47 return false;
48}
49
50void PurityChecker::Entered(
51 parser::CharBlock source, const std::list<parser::PrefixSpec> &prefixes) {
52 if (depth_ == 2) {
53 context_.messages().Say(source,
54 "An internal subprogram may not contain an internal subprogram"_err_en_US);
55 }
56 if (HasPurePrefix(prefixes)) {
57 if (pureDepth_ < 0) {
58 pureDepth_ = depth_;
59 }
60 } else if (InPureSubprogram()) {
61 context_.messages().Say(source,
62 "An internal subprogram of a pure subprogram must also be pure"_err_en_US);
63 }
64 ++depth_;
65}
66
67void PurityChecker::Left() {
68 if (pureDepth_ == --depth_) {
69 pureDepth_ = -1;
70 }
71}
72
73} // namespace Fortran::semantics
74

source code of flang/lib/Semantics/check-purity.cpp