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 13 namespace Fortran::semantics { 14 void 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 } 20 void 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 26 void PurityChecker::Leave(const parser::SubroutineSubprogram &) { Left(); } 27 28 void 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 34 void PurityChecker::Leave(const parser::FunctionSubprogram &func) { Left(); } 35 36 bool PurityChecker::InPureSubprogram() const { 37 return pureDepth_ >= 0 && depth_ >= pureDepth_; 38 } 39 40 bool 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 54 void 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 71 void PurityChecker::Left() { 72 if (pureDepth_ == --depth_) { 73 pureDepth_ = -1; 74 } 75 } 76 77 } // namespace Fortran::semantics 78