check-do-concurrent.cc
check-if-construct.cc
check-if-stmt.cc
+ check-nullify.cc
expression.cc
mod-file.cc
resolve-labels.cc
--- /dev/null
+// 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
--- /dev/null
+// 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_
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;
left.Rank(), right.Rank());
}
}
+
+template<typename A>
+std::optional<evaluate::DataRef> ExtractDataRef(std::optional<A> &&x);
} // namespace Fortran::evaluate
namespace Fortran::semantics {
#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"
using StatementSemanticsPass1 = SemanticsVisitor<ExprChecker>;
using StatementSemanticsPass2 = SemanticsVisitor<ArithmeticIfStmtChecker,
AssignmentChecker, ComputedGotoStmtChecker, DoConcurrentChecker,
- IfConstructChecker, IfStmtChecker>;
+ IfConstructChecker, IfStmtChecker, NullifyChecker>;
SemanticsContext::SemanticsContext(
const common::IntrinsicTypeDefaultKinds &defaultKinds,
}
}
+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) {
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
if_stmt03.f90
computed-goto01.f90
computed-goto02.f90
+ nullify01.f90
+ nullify02.f90
)
# These test files have expected symbols in the source
--- /dev/null
+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
--- /dev/null
+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