llvm-project

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
  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