flang/lib/Semantics/check-nullify.cpp

   1 //===-- lib/Semantics/check-nullify.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-nullify.h"
  10 #include "definable.h"
  11 #include "flang/Evaluate/expression.h"
  12 #include "flang/Parser/message.h"
  13 #include "flang/Parser/parse-tree.h"
  14 #include "flang/Semantics/expression.h"
  15 #include "flang/Semantics/tools.h"
  16
  17 namespace Fortran::semantics {
  18
  19 void NullifyChecker::Leave(const parser::NullifyStmt &nullifyStmt) {
  20   CHECK(context_.location());
  21   const Scope &scope{context_.FindScope(*context_.location())};
  22   for (const parser::PointerObject &pointerObject : nullifyStmt.v) {
  23     common::visit(
  24         common::visitors{
  25             [&](const parser::Name &name) {
  26               if (name.symbol) {
  27                 if (auto whyNot{WhyNotDefinable(name.source, scope,
  28                         DefinabilityFlags{DefinabilityFlag::PointerDefinition},
  29                         *name.symbol)}) {
  30                   context_.messages()
  31                       .Say(name.source,
  32                           "'%s' may not appear in NULLIFY"_err_en_US,
  33                           name.source)
  34                       .Attach(std::move(
  35                           whyNot->set_severity(parser::Severity::Because)));
  36                 }
  37               }
  38             },
  39             [&](const parser::StructureComponent &structureComponent) {
  40               const auto &component{structureComponent.component};
  41               SourceName at{component.source};
  42               if (const auto *checkedExpr{GetExpr(context_, pointerObject)}) {
  43                 if (auto whyNot{WhyNotDefinable(at, scope,
  44                         DefinabilityFlags{DefinabilityFlag::PointerDefinition},
  45                         *checkedExpr)}) {
  46                   context_.messages()
  47                       .Say(at, "'%s' may not appear in NULLIFY"_err_en_US, at)
  48                       .Attach(std::move(
  49                           whyNot->set_severity(parser::Severity::Because)));
  50                 }
  51               }
  52             },
  53         },
  54         pointerObject.u);
  55   }
  56   // From 9.7.3.1(1)
  57   //   A pointer-object shall not depend on the value,
  58   //   bounds, or association status of another pointer-
  59   //   object in the same NULLIFY statement.
  60   // This restriction is the programmer's responsibility.
  61   // Some dependencies can be found compile time or at
  62   // runtime, but for now we choose to skip such checks.
  63 }
  64 } // namespace Fortran::semantics