flang/lib/Semantics/check-purity.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-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 &) { 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   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
  50 void 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
  67 void PurityChecker::Left() {
  68   if (pureDepth_ == --depth_) {
  69     pureDepth_ = -1;
  70   }
  71 }
  72
  73 } // namespace Fortran::semantics