From 70285af0adb0be8a94c30b697735d6bfd34ba9ee Mon Sep 17 00:00:00 2001 From: Steve Scalpone Date: Wed, 10 Apr 2019 22:17:44 -0700 Subject: [PATCH] [flang] Implement semantic checks for DEALLOCATE statements. The parser checks for duplicate dealloc-opts and expr analysis checks that dealloc-opts are the right type. Original-commit: flang-compiler/f18@1ade7f66177c8d7698b1e9da12904352c520e9d1 Reviewed-on: https://github.com/flang-compiler/f18/pull/401 Tree-same-pre-rewrite: false --- flang/lib/semantics/CMakeLists.txt | 1 + flang/lib/semantics/check-deallocate.cc | 79 +++++++++++++++++++++++++ flang/lib/semantics/check-deallocate.h | 34 +++++++++++ flang/lib/semantics/semantics.cc | 5 +- flang/lib/semantics/tools.cc | 8 +++ flang/lib/semantics/tools.h | 2 + flang/test/semantics/CMakeLists.txt | 2 + flang/test/semantics/deallocate01.f90 | 61 +++++++++++++++++++ flang/test/semantics/deallocate04.f90 | 69 +++++++++++++++++++++ 9 files changed, 259 insertions(+), 2 deletions(-) create mode 100644 flang/lib/semantics/check-deallocate.cc create mode 100644 flang/lib/semantics/check-deallocate.h create mode 100644 flang/test/semantics/deallocate01.f90 create mode 100644 flang/test/semantics/deallocate04.f90 diff --git a/flang/lib/semantics/CMakeLists.txt b/flang/lib/semantics/CMakeLists.txt index 5bd69e4845ff..7a9797d54f73 100644 --- a/flang/lib/semantics/CMakeLists.txt +++ b/flang/lib/semantics/CMakeLists.txt @@ -18,6 +18,7 @@ add_library(FortranSemantics canonicalize-do.cc check-arithmeticif.cc check-computed-goto.cc + check-deallocate.cc check-do-concurrent.cc check-if-construct.cc check-if-stmt.cc diff --git a/flang/lib/semantics/check-deallocate.cc b/flang/lib/semantics/check-deallocate.cc new file mode 100644 index 000000000000..2a3599d4a590 --- /dev/null +++ b/flang/lib/semantics/check-deallocate.cc @@ -0,0 +1,79 @@ +// 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-deallocate.h" +#include "expression.h" +#include "tools.h" +#include "../parser/message.h" +#include "../parser/parse-tree.h" + +namespace Fortran::semantics { + +void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) { + for (const parser::AllocateObject &allocateObject : + std::get>(deallocateStmt.t)) { + std::visit( + common::visitors{ + [&](const parser::Name &name) { + auto const *symbol{name.symbol}; + if (!IsVariableName(*symbol)) { + context_.messages().Say(name.source, + "name in DEALLOCATE statement must be a variable name"_err_en_US); + } else if (!IsAllocatableOrPointer(*symbol)) { // C951 + context_.messages().Say(name.source, + "name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US); + } + }, + [&](const parser::StructureComponent &structureComponent) { + evaluate::ExpressionAnalyzer analyzer{context_}; + if (MaybeExpr checked{analyzer.Analyze(structureComponent)}) { + if (!IsAllocatableOrPointer( + *structureComponent.component.symbol)) { // C951 + context_.messages().Say(structureComponent.component.source, + "component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US); + } + } + }, + }, + allocateObject.u); + } + // The parser is catchng dups too + bool gotStat{false}, gotMsg{false}; + for (const parser::StatOrErrmsg &deallocOpt : + std::get>(deallocateStmt.t)) { + std::visit( + common::visitors{ + [&](const parser::StatVariable &statVariable) { + // ExpressionAnalyzer emits error messages + evaluate::ExpressionAnalyzer analyzer{context_}; + (void)analyzer.Analyze(statVariable.v); + if(gotStat) { + context_.Say("STAT may not be duplicated in a DEALLOCATE statement"_err_en_US); + } + gotStat = true; + }, + [&](const parser::MsgVariable &msgVariable) { + // ExpressionAnalyzer emits error messages + evaluate::ExpressionAnalyzer analyzer{context_}; + (void)analyzer.Analyze(msgVariable.v); + if(gotMsg) { + context_.Say("ERRMSG may not be duplicated in a DEALLOCATE statement"_err_en_US); + } + gotMsg = true; + }, + }, + deallocOpt.u); + } +} +} // namespace Fortran::semantics diff --git a/flang/lib/semantics/check-deallocate.h b/flang/lib/semantics/check-deallocate.h new file mode 100644 index 000000000000..79ce3a01134b --- /dev/null +++ b/flang/lib/semantics/check-deallocate.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_DEALLOCATE_H_ +#define FORTRAN_SEMANTICS_CHECK_DEALLOCATE_H_ + +#include "semantics.h" + +namespace Fortran::parser { +struct DeallocateStmt; +} + +namespace Fortran::semantics { +class DeallocateChecker : public virtual BaseChecker { +public: + inline DeallocateChecker(SemanticsContext &context) : context_{context} {} + void Leave(const parser::DeallocateStmt &); + +private: + SemanticsContext &context_; +}; +} +#endif // FORTRAN_SEMANTICS_CHECK_DEALLOCATE_H_ diff --git a/flang/lib/semantics/semantics.cc b/flang/lib/semantics/semantics.cc index 2c70f8354f7b..53da7a622462 100644 --- a/flang/lib/semantics/semantics.cc +++ b/flang/lib/semantics/semantics.cc @@ -17,6 +17,7 @@ #include "canonicalize-do.h" #include "check-arithmeticif.h" #include "check-computed-goto.h" +#include "check-deallocate.h" #include "check-do-concurrent.h" #include "check-if-construct.h" #include "check-if-stmt.h" @@ -78,8 +79,8 @@ private: using StatementSemanticsPass1 = SemanticsVisitor; using StatementSemanticsPass2 = SemanticsVisitor; + AssignmentChecker, ComputedGotoStmtChecker, DeallocateChecker, + DoConcurrentChecker, IfConstructChecker, IfStmtChecker, NullifyChecker>; SemanticsContext::SemanticsContext( const common::IntrinsicTypeDefaultKinds &defaultKinds, diff --git a/flang/lib/semantics/tools.cc b/flang/lib/semantics/tools.cc index 85fbf3f8c65b..54081b88afc7 100644 --- a/flang/lib/semantics/tools.cc +++ b/flang/lib/semantics/tools.cc @@ -123,10 +123,18 @@ bool IsPointer(const Symbol &symbol) { return symbol.attrs().test(Attr::POINTER); } +bool IsAllocatable(const Symbol &symbol) { + return symbol.attrs().test(Attr::ALLOCATABLE); +} + bool IsPointerDummy(const Symbol &symbol) { return IsPointer(symbol) && IsDummy(symbol); } +bool IsAllocatableOrPointer(const Symbol &symbol) { + return IsPointer(symbol) || IsAllocatable(symbol); +} + bool IsParameter(const Symbol &symbol) { return symbol.attrs().test(Attr::PARAMETER); } diff --git a/flang/lib/semantics/tools.h b/flang/lib/semantics/tools.h index 04f095952282..b08b997a4830 100644 --- a/flang/lib/semantics/tools.h +++ b/flang/lib/semantics/tools.h @@ -49,6 +49,8 @@ bool IsPureFunction(const Symbol &); bool IsPureFunction(const Scope &); bool IsProcName(const Symbol &symbol); // proc-name bool IsVariableName(const Symbol &symbol); // variable-name +bool IsAllocatable(const Symbol &); +bool IsAllocatableOrPointer(const Symbol &); // Determines whether an object might be visible outside a // PURE function (C1594); returns a non-null Symbol pointer for diff --git a/flang/test/semantics/CMakeLists.txt b/flang/test/semantics/CMakeLists.txt index 850ae558f77f..ea6e7d1f1b09 100644 --- a/flang/test/semantics/CMakeLists.txt +++ b/flang/test/semantics/CMakeLists.txt @@ -91,6 +91,8 @@ set(ERROR_TESTS computed-goto02.f90 nullify01.f90 nullify02.f90 + deallocate01.f90 + deallocate04.f90 ) # These test files have expected symbols in the source diff --git a/flang/test/semantics/deallocate01.f90 b/flang/test/semantics/deallocate01.f90 new file mode 100644 index 000000000000..a8ecdbd14dd8 --- /dev/null +++ b/flang/test/semantics/deallocate01.f90 @@ -0,0 +1,61 @@ +! 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. + +! Test that DEALLOCATE works + +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 :: s +CHARACTER(256) :: e + +Integer, Pointer :: pi + +Allocate(p) +Allocate(x(3)) + +Deallocate(x(2)%p) + +Deallocate(y(2)%p) + +Deallocate(pi) + +Deallocate(z%p) + +Deallocate(x%p, stat=s, errmsg=e) +Deallocate(x%p, errmsg=e) +Deallocate(x%p, stat=s) + +Deallocate(y%p, stat=s, errmsg=e) +Deallocate(y%p, errmsg=e) +Deallocate(y%p, stat=s) + +Deallocate(z, stat=s, errmsg=e) +Deallocate(z, errmsg=e) +Deallocate(z, stat=s) + +Deallocate(z, y%p, stat=s, errmsg=e) +Deallocate(z, y%p, errmsg=e) +Deallocate(z, y%p, stat=s) + +End Program diff --git a/flang/test/semantics/deallocate04.f90 b/flang/test/semantics/deallocate04.f90 new file mode 100644 index 000000000000..52c6f9398e2e --- /dev/null +++ b/flang/test/semantics/deallocate04.f90 @@ -0,0 +1,69 @@ +! 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. + +! Check for semantic errors in DEALLOCATE statements + +INTEGER, PARAMETER :: maxvalue=1024 + +Type dt + Integer :: l = 3 +End Type +Type t + Type(dt) :: p +End Type + +Type(t),Allocatable :: x(:) + +Real :: r +Integer :: s +Integer :: e +Integer :: pi +Character(256) :: ee +Procedure(Real) :: prp + +Allocate(x(3)) + +!ERROR: component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute +Deallocate(x(2)%p) + +!ERROR: name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute +Deallocate(pi) + +!ERROR: component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute +!ERROR: name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute +Deallocate(x(2)%p, pi) + +!ERROR: name in DEALLOCATE statement must be a variable name +Deallocate(prp) + +!ERROR: name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute +!ERROR: name in DEALLOCATE statement must be a variable name +Deallocate(pi, prp) + +!ERROR: name in DEALLOCATE statement must be a variable name +Deallocate(maxvalue) + +!ERROR: component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute +Deallocate(x%p) + +!ERROR: component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute +!ERROR: Must have default CHARACTER type +Deallocate(x%p, stat=s, errmsg=e) + +!ERROR: component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute +!ERROR: Must have INTEGER type +!ERROR: Must have default CHARACTER type +Deallocate(x%p, stat=r, errmsg=e) + +End Program -- 2.34.1