Merge pull request flang-compiler#989 from flang-compiler/tsk-forall

Add FORALL checking to DoChecker

Author: tskeith

include/flang/evaluate/expression.h

@@ -811,28 +811,24 @@ template<> class Expr<SomeType> : public ExpressionBase<SomeType> {
  common::CombineVariants<TypelessExpression, CategoryExpression> u;
 };
 
-// An assignment is either intrinsic (with lhs and rhs) or user-defined,
-// represented as a ProcedureRef. A pointer assignment optionally also has
-// a bounds-spec or bounds-remapping.
+// An assignment is either intrinsic, user-defined (with a ProcedureRef to
+// specify the procedure to call), or pointer assignment (with possibly empty
+// BoundsSpec or non-empty BoundsRemapping). In all cases there are Exprs
+// representing the LHS and RHS of the assignment.
 class Assignment {
 public:
- UNION_CONSTRUCTORS(Assignment)
- struct IntrinsicAssignment {
- Expr<SomeType> lhs;
- Expr<SomeType> rhs;
- };
- struct PointerAssignment {
- using BoundsSpec = std::vector<Expr<SubscriptInteger>>;
- using BoundsRemapping =
- std::vector<std::pair<Expr<SubscriptInteger>, Expr<SubscriptInteger>>>;
- PointerAssignment(Expr<SomeType> &&lhs, Expr<SomeType> &&rhs)
- : lhs{std::move(lhs)}, rhs{std::move(rhs)} {}
- Expr<SomeType> lhs;
- Expr<SomeType> rhs;
- std::variant<BoundsSpec, BoundsRemapping> bounds;
- };
+ Assignment(Expr<SomeType> &&lhs, Expr<SomeType> &&rhs)
+ : lhs(std::move(lhs)), rhs(std::move(rhs)) {}
+
+ struct Intrinsic {};
+ using BoundsSpec = std::vector<Expr<SubscriptInteger>>;
+ using BoundsRemapping =
+ std::vector<std::pair<Expr<SubscriptInteger>, Expr<SubscriptInteger>>>;
  std::ostream &AsFortran(std::ostream &) const;
- std::variant<IntrinsicAssignment, ProcedureRef, PointerAssignment> u;
+
+ Expr<SomeType> lhs;
+ Expr<SomeType> rhs;
+ std::variant<Intrinsic, ProcedureRef, BoundsSpec, BoundsRemapping> u;
 };
 
 // This wrapper class is used, by means of a forward reference with

include/flang/evaluate/tools.h

@@ -843,5 +843,8 @@ parser::Message *SayWithDeclaration(
 // of one to complain about, if any exist.
 std::optional<std::string> FindImpureCall(
  const IntrinsicProcTable &, const Expr<SomeType> &);
+std::optional<std::string> FindImpureCall(
+ const IntrinsicProcTable &, const ProcedureRef &);
+
 }
 #endif // FORTRAN_EVALUATE_TOOLS_H_

include/flang/semantics/semantics.h

@@ -150,19 +150,18 @@ class SemanticsContext {
  }
  void PopConstruct();
 
- // Check to see if a variable being redefined is a DO variable. If so, emit
- // a message
- void WarnDoVarRedefine(const parser::CharBlock &, const Symbol &);
- void CheckDoVarRedefine(const parser::CharBlock &, const Symbol &);
- void CheckDoVarRedefine(const parser::Variable &);
- void CheckDoVarRedefine(const parser::Name &);
- void ActivateDoVariable(const parser::Name &);
- void DeactivateDoVariable(const parser::Name &);
- bool IsActiveDoVariable(const Symbol &);
+ ENUM_CLASS(IndexVarKind, DO, FORALL)
+ // Check to see if a variable being redefined is a DO or FORALL index.
+ // If so, emit a message.
+ void WarnIndexVarRedefine(const parser::CharBlock &, const Symbol &);
+ void CheckIndexVarRedefine(const parser::CharBlock &, const Symbol &);
+ void CheckIndexVarRedefine(const parser::Variable &);
+ void CheckIndexVarRedefine(const parser::Name &);
+ void ActivateIndexVar(const parser::Name &, IndexVarKind);
+ void DeactivateIndexVar(const parser::Name &);
 
 private:
- parser::CharBlock GetDoVariableLocation(const Symbol &);
- void CheckDoVarRedefine(
+ void CheckIndexVarRedefine(
  const parser::CharBlock &, const Symbol &, parser::MessageFixedText &&);
  const common::IntrinsicTypeDefaultKinds &defaultKinds_;
  const common::LanguageFeatureControl languageFeatures_;
@@ -180,7 +179,11 @@ class SemanticsContext {
 
  bool CheckError(bool);
  ConstructStack constructStack_;
- std::map<SymbolRef, const parser::CharBlock> activeDoVariables_;
+ struct IndexVarInfo {
+ parser::CharBlock location;
+ IndexVarKind kind;
+ };
+ std::map<SymbolRef, const IndexVarInfo> activeIndexVars_;
 };
 
 class Semantics {

lib/evaluate/expression.cpp

@@ -168,40 +168,33 @@ GenericExprWrapper::~GenericExprWrapper() {}
 std::ostream &Assignment::AsFortran(std::ostream &o) const {
  std::visit(
  common::visitors{
- [&](const evaluate::Assignment::IntrinsicAssignment &x) {
- x.rhs.AsFortran(x.lhs.AsFortran(o) << '=');
+ [&](const Assignment::Intrinsic &) {
+ rhs.AsFortran(lhs.AsFortran(o) << '=');
  },
- [&](const evaluate::ProcedureRef &x) { x.AsFortran(o << "CALL "); },
- [&](const evaluate::Assignment::PointerAssignment &x) {
- x.lhs.AsFortran(o);
- std::visit(
- common::visitors{
- [&](const evaluate::Assignment::PointerAssignment::
- BoundsSpec &bounds) {
- if (!bounds.empty()) {
- char sep{'('};
- for (const auto &bound : bounds) {
- bound.AsFortran(o << sep) << ':';
- sep = ',';
- }
- o << ')';
- }
- },
- [&](const evaluate::Assignment::PointerAssignment::
- BoundsRemapping &bounds) {
- if (!bounds.empty()) {
- char sep{'('};
- for (const auto &bound : bounds) {
- bound.first.AsFortran(o << sep) << ':';
- bound.second.AsFortran(o);
- sep = ',';
- }
- o << ')';
- }
- },
- },
- x.bounds);
- x.rhs.AsFortran(o << " => ");
+ [&](const ProcedureRef &proc) { proc.AsFortran(o << "CALL "); },
+ [&](const BoundsSpec &bounds) {
+ lhs.AsFortran(o);
+ if (!bounds.empty()) {
+ char sep{'('};
+ for (const auto &bound : bounds) {
+ bound.AsFortran(o << sep) << ':';
+ sep = ',';
+ }
+ o << ')';
+ }
+ },
+ [&](const BoundsRemapping &bounds) {
+ lhs.AsFortran(o);
+ if (!bounds.empty()) {
+ char sep{'('};
+ for (const auto &bound : bounds) {
+ bound.first.AsFortran(o << sep) << ':';
+ bound.second.AsFortran(o);
+ sep = ',';
+ }
+ o << ')';
+ }
+ rhs.AsFortran(o << " => ");
  },
  },
  u);

lib/evaluate/tools.cpp

@@ -842,5 +842,9 @@ std::optional<std::string> FindImpureCall(
  const IntrinsicProcTable &intrinsics, const Expr<SomeType> &expr) {
  return FindImpureCallHelper{intrinsics}(expr);
 }
+std::optional<std::string> FindImpureCall(
+ const IntrinsicProcTable &intrinsics, const ProcedureRef &proc) {
+ return FindImpureCallHelper{intrinsics}(proc);
+}
 
 }

lib/semantics/CMakeLists.txt

@@ -17,7 +17,7 @@ add_library(FortranSemantics
  check-coarray.cpp
  check-deallocate.cpp
  check-declarations.cpp
- check-do.cpp
+ check-do-forall.cpp
  check-if-stmt.cpp
  check-io.cpp
  check-nullify.cpp