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