[flang] Check semantic contraints for the nullify statement. The full

legality check is up to the user; however, some checks could
be done at compile time and others at runtime.  We choose to
skip any checking at compile time because it would not be
complete.

Note the instantiation of ExtractDataRef in expressions.cc.
This instantiation satifies the reference in check-nullify.cc
because expression.h just has a declaration of ExtractDataRef
instead of the definition.

Original-commit: flang-compiler/f18@b7199219fb
Reviewed-on: https://github.com/flang-compiler/f18/pull/388
Tree-same-pre-rewrite: false

flang/lib/semantics/CMakeLists.txt

@@ -21,6 +21,7 @@ add_library(FortranSemantics
   check-do-concurrent.cc
   check-if-construct.cc
   check-if-stmt.cc
+  check-nullify.cc
   expression.cc
   mod-file.cc
   resolve-labels.cc

flang/lib/semantics/check-nullify.cc

@@ -0,0 +1,67 @@
+// Copyright (c) 2019, NVIDIA CORPORATION.  All rights reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+//     http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+
+#include "check-nullify.h"
+#include "expression.h"
+#include "tools.h"
+#include "../evaluate/expression.h"
+#include "../parser/message.h"
+#include "../parser/parse-tree.h"
+
+#include "../parser/dump-parse-tree.h"
+#include <iostream>
+
+namespace Fortran::semantics {
+
+void NullifyChecker::Leave(const parser::NullifyStmt &nullifyStmt) {
+  // R938
+  for (const parser::PointerObject &pointerObject : nullifyStmt.v) {
+    // R939
+    std::visit(
+        common::visitors{
+            [&](const parser::Name &name) {
+              auto const *symbol{name.symbol};
+              if (!IsVariableName(*symbol) && !IsProcName(*symbol)) {
+                context_.messages().Say(name.source,
+                    "name must be a variable or procedure pointer name"_err_en_US);
+              } else if (!IsPointer(*symbol)) {  // C951
+                context_.messages().Say(name.source,
+                    "name must have the POINTER attribute"_err_en_US);
+              }
+            },
+            [&](const parser::StructureComponent &structureComponent) {
+              evaluate::ExpressionAnalyzer analyzer{context_};
+              if (MaybeExpr checked{analyzer.Analyze(structureComponent)}) {
+                if (std::optional<evaluate::DataRef> dataRef{
+                        evaluate::ExtractDataRef(std::move(checked))}) {
+                  const Symbol &symbol{dataRef->GetLastSymbol()};
+                  if (!IsPointer(symbol)) {  // C951
+                    context_.messages().Say(structureComponent.component.source,
+                        "component must have the POINTER attribute"_err_en_US);
+                  }
+                }
+              }
+            },
+        },
+        pointerObject.u);
+  }
+  // From 9.7.3.1(1)
+  //   A pointer-object shall not depend on the value,
+  //   bounds, or association status of another pointer-
+  //   object in the same NULLIFY statement.
+  // This restriction is the programmer's responsibilty.
+  // Some dependencies can be found compile time or at
+  // runtime, but for now we choose to skip such checks.
+}
+}  // namespace Fortran::semantics

flang/lib/semantics/check-nullify.h

@@ -0,0 +1,34 @@
+// Copyright (c) 2019, NVIDIA CORPORATION.  All rights reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+//     http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+
+#ifndef FORTRAN_SEMANTICS_CHECK_NULLIFY_H_
+#define FORTRAN_SEMANTICS_CHECK_NULLIFY_H_
+
+#include "semantics.h"
+
+namespace Fortran::parser {
+struct NullifyStmt;
+}
+
+namespace Fortran::semantics {
+class NullifyChecker : public virtual BaseChecker {
+public:
+  inline NullifyChecker(SemanticsContext &context) : context_{context} {}
+  void Leave(const parser::NullifyStmt &);
+
+private:
+  SemanticsContext &context_;
+};
+}
+#endif  // FORTRAN_SEMANTICS_CHECK_NULLIFY_H_

flang/lib/semantics/expression.cc

@@ -111,6 +111,11 @@ std::optional<DataRef> ExtractDataRef(std::optional<A> &&x) {
   return std::nullopt;
 }
 
+// Explicit instantiation instead of moving all ExtractDataRef templates to the
+// header
+template std::optional<DataRef> ExtractDataRef<Expr<SomeType>>(
+    std::optional<Expr<SomeType>> &&);
+
 struct DynamicTypeWithLength : public DynamicType {
   std::optional<Expr<SubscriptInteger>> LEN() const;
   std::optional<Expr<SubscriptInteger>> length;

flang/lib/semantics/expression.h

@@ -278,6 +278,9 @@ void ConformabilityCheck(
         left.Rank(), right.Rank());
   }
 }
+
+template<typename A>
+std::optional<evaluate::DataRef> ExtractDataRef(std::optional<A> &&x);
 }  // namespace Fortran::evaluate
 
 namespace Fortran::semantics {

flang/lib/semantics/semantics.cc

@@ -20,6 +20,7 @@
 #include "check-do-concurrent.h"
 #include "check-if-construct.h"
 #include "check-if-stmt.h"
+#include "check-nullify.h"
 #include "expression.h"
 #include "mod-file.h"
 #include "resolve-labels.h"
@@ -78,7 +79,7 @@ private:
 using StatementSemanticsPass1 = SemanticsVisitor<ExprChecker>;
 using StatementSemanticsPass2 = SemanticsVisitor<ArithmeticIfStmtChecker,
     AssignmentChecker, ComputedGotoStmtChecker, DoConcurrentChecker,
-    IfConstructChecker, IfStmtChecker>;
+    IfConstructChecker, IfStmtChecker, NullifyChecker>;
 
 SemanticsContext::SemanticsContext(
     const common::IntrinsicTypeDefaultKinds &defaultKinds,

flang/lib/semantics/tools.cc

@@ -119,8 +119,26 @@ bool IsDummy(const Symbol &symbol) {
   }
 }
 
+bool IsPointer(const Symbol &symbol) {
+  return symbol.attrs().test(Attr::POINTER);
+}
+
 bool IsPointerDummy(const Symbol &symbol) {
-  return symbol.attrs().test(Attr::POINTER) && IsDummy(symbol);
+  return IsPointer(symbol) && IsDummy(symbol);
+}
+
+bool IsParameter(const Symbol &symbol) {
+  return symbol.attrs().test(Attr::PARAMETER);
+}
+
+// variable-name
+bool IsVariableName(const Symbol &symbol) {
+  return symbol.has<ObjectEntityDetails>() && !IsParameter(symbol);
+}
+
+// proc-name
+bool IsProcName(const Symbol &symbol) {
+  return symbol.has<ProcEntityDetails>();
 }
 
 bool IsFunction(const Symbol &symbol) {

flang/lib/semantics/tools.h

@@ -42,10 +42,13 @@ bool DoesScopeContain(const Scope *, const Symbol &);
 bool IsUseAssociated(const Symbol *, const Scope &);
 bool IsHostAssociated(const Symbol &, const Scope &);
 bool IsDummy(const Symbol &);
+bool IsPointer(const Symbol &);
 bool IsPointerDummy(const Symbol &);
 bool IsFunction(const Symbol &);
 bool IsPureFunction(const Symbol &);
 bool IsPureFunction(const Scope &);
+bool IsProcName(const Symbol &symbol);  // proc-name
+bool IsVariableName(const Symbol &symbol);  // variable-name
 
 // Determines whether an object might be visible outside a
 // PURE function (C1594); returns a non-null Symbol pointer for

flang/test/semantics/CMakeLists.txt

@@ -89,6 +89,8 @@ set(ERROR_TESTS
   if_stmt03.f90
   computed-goto01.f90
   computed-goto02.f90
+  nullify01.f90
+  nullify02.f90
 )
 
 # These test files have expected symbols in the source

flang/test/semantics/nullify01.f90

@@ -0,0 +1,27 @@
+INTEGER, PARAMETER :: maxvalue=1024
+
+Type dt
+  Integer :: l = 3
+End Type
+Type t
+  Type(dt),Pointer :: p
+End Type
+
+Type(t),Allocatable :: x(:)
+Type(t),Pointer :: y(:)
+Type(t),Pointer :: z
+
+Integer, Pointer :: pi
+Procedure(Real), Pointer :: prp
+
+Allocate(x(3))
+Nullify(x(2)%p)
+
+Nullify(y(2)%p)
+
+Nullify(pi)
+Nullify(prp)
+
+Nullify(z%p)
+
+End Program

flang/test/semantics/nullify02.f90

@@ -0,0 +1,28 @@
+INTEGER, PARAMETER :: maxvalue=1024
+
+Type dt
+  Integer :: l = 3
+End Type
+Type t
+  Type(dt) :: p
+End Type
+
+Type(t),Allocatable :: x(:)
+
+Integer :: pi
+Procedure(Real) :: prp
+
+Allocate(x(3))
+!ERROR: component must have the POINTER attribute
+Nullify(x(2)%p)
+
+!ERROR: name must have the POINTER attribute
+Nullify(pi)
+
+!ERROR: name must have the POINTER attribute
+Nullify(prp)
+
+!ERROR: name must be a variable or procedure pointer name
+Nullify(maxvalue)
+
+End Program