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 { Enter(const parser::ExecutableConstruct & exec)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 } Enter(const parser::SubroutineSubprogram & subr)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 Leave(const parser::SubroutineSubprogram &)26void PurityChecker::Leave(const parser::SubroutineSubprogram &) { Left(); } 27 Enter(const parser::FunctionSubprogram & func)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 Leave(const parser::FunctionSubprogram &)34void PurityChecker::Leave(const parser::FunctionSubprogram &) { Left(); } 35 InPureSubprogram() const36bool PurityChecker::InPureSubprogram() const { 37 return pureDepth_ >= 0 && depth_ >= pureDepth_; 38 } 39 HasPurePrefix(const std::list<parser::PrefixSpec> & prefixes) const40bool 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 Entered(parser::CharBlock source,const std::list<parser::PrefixSpec> & prefixes)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 Left()67void PurityChecker::Left() { 68 if (pureDepth_ == --depth_) { 69 pureDepth_ = -1; 70 } 71 } 72 73 } // namespace Fortran::semantics 74