164ab3302SCarolineConcatto //===-- lib/Semantics/check-nullify.cpp -----------------------------------===//
264ab3302SCarolineConcatto //
364ab3302SCarolineConcatto // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
464ab3302SCarolineConcatto // See https://llvm.org/LICENSE.txt for license information.
564ab3302SCarolineConcatto // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
664ab3302SCarolineConcatto //
764ab3302SCarolineConcatto //===----------------------------------------------------------------------===//
864ab3302SCarolineConcatto 
964ab3302SCarolineConcatto #include "check-nullify.h"
1064ab3302SCarolineConcatto #include "assignment.h"
1164ab3302SCarolineConcatto #include "flang/Evaluate/expression.h"
1264ab3302SCarolineConcatto #include "flang/Parser/message.h"
1364ab3302SCarolineConcatto #include "flang/Parser/parse-tree.h"
1464ab3302SCarolineConcatto #include "flang/Semantics/expression.h"
1564ab3302SCarolineConcatto #include "flang/Semantics/tools.h"
1664ab3302SCarolineConcatto 
1764ab3302SCarolineConcatto namespace Fortran::semantics {
1864ab3302SCarolineConcatto 
Leave(const parser::NullifyStmt & nullifyStmt)1964ab3302SCarolineConcatto void NullifyChecker::Leave(const parser::NullifyStmt &nullifyStmt) {
2064ab3302SCarolineConcatto   CHECK(context_.location());
2164ab3302SCarolineConcatto   const Scope &scope{context_.FindScope(*context_.location())};
2264ab3302SCarolineConcatto   const Scope *pure{FindPureProcedureContaining(scope)};
2364ab3302SCarolineConcatto   parser::ContextualMessages messages{
2464ab3302SCarolineConcatto       *context_.location(), &context_.messages()};
2564ab3302SCarolineConcatto   for (const parser::PointerObject &pointerObject : nullifyStmt.v) {
26cd03e96fSPeter Klausler     common::visit(
2764ab3302SCarolineConcatto         common::visitors{
2864ab3302SCarolineConcatto             [&](const parser::Name &name) {
29cfd7d812SPeter Steinfeld               const Symbol *symbol{name.symbol};
30cfd7d812SPeter Steinfeld               if (context_.HasError(symbol)) {
3164ab3302SCarolineConcatto                 // already reported an error
32*8594b051SPeter Klausler               } else if (!IsVariableName(*symbol) &&
33*8594b051SPeter Klausler                   !IsProcedurePointer(*symbol)) {
3464ab3302SCarolineConcatto                 messages.Say(name.source,
35*8594b051SPeter Klausler                     "name in NULLIFY statement must be a variable or procedure pointer"_err_en_US);
36cfd7d812SPeter Steinfeld               } else if (!IsPointer(*symbol)) { // C951
3764ab3302SCarolineConcatto                 messages.Say(name.source,
3864ab3302SCarolineConcatto                     "name in NULLIFY statement must have the POINTER attribute"_err_en_US);
3964ab3302SCarolineConcatto               } else if (pure) {
40cfd7d812SPeter Steinfeld                 CheckDefinabilityInPureScope(messages, *symbol, scope, *pure);
4164ab3302SCarolineConcatto               }
4264ab3302SCarolineConcatto             },
4364ab3302SCarolineConcatto             [&](const parser::StructureComponent &structureComponent) {
447e225423SPeter Klausler               if (const auto *checkedExpr{GetExpr(context_, pointerObject)}) {
4564ab3302SCarolineConcatto                 if (!IsPointer(*structureComponent.component.symbol)) { // C951
4664ab3302SCarolineConcatto                   messages.Say(structureComponent.component.source,
4764ab3302SCarolineConcatto                       "component in NULLIFY statement must have the POINTER attribute"_err_en_US);
4864ab3302SCarolineConcatto                 } else if (pure) {
4992d27b96SJean Perier                   if (const Symbol * symbol{GetFirstSymbol(*checkedExpr)}) {
5064ab3302SCarolineConcatto                     CheckDefinabilityInPureScope(
5164ab3302SCarolineConcatto                         messages, *symbol, scope, *pure);
5264ab3302SCarolineConcatto                   }
5364ab3302SCarolineConcatto                 }
5464ab3302SCarolineConcatto               }
5564ab3302SCarolineConcatto             },
5664ab3302SCarolineConcatto         },
5764ab3302SCarolineConcatto         pointerObject.u);
5864ab3302SCarolineConcatto   }
5964ab3302SCarolineConcatto   // From 9.7.3.1(1)
6064ab3302SCarolineConcatto   //   A pointer-object shall not depend on the value,
6164ab3302SCarolineConcatto   //   bounds, or association status of another pointer-
6264ab3302SCarolineConcatto   //   object in the same NULLIFY statement.
6364ab3302SCarolineConcatto   // This restriction is the programmer's responsibilty.
6464ab3302SCarolineConcatto   // Some dependencies can be found compile time or at
6564ab3302SCarolineConcatto   // runtime, but for now we choose to skip such checks.
6664ab3302SCarolineConcatto }
671f879005STim Keith } // namespace Fortran::semantics
68