From 8a574332731bf03659d8ef40870540925a33576d Mon Sep 17 00:00:00 2001 From: peter klausler Date: Fri, 1 Mar 2019 17:33:20 -0800 Subject: [PATCH] [flang] C1594 constraint checking on pointer components in struct constructors Original-commit: flang-compiler/f18@386cd8a9b43f4e65c3e42febbae991fa87d277a9 Reviewed-on: https://github.com/flang-compiler/f18/pull/311 Tree-same-pre-rewrite: false --- flang/lib/evaluate/variable.h | 7 ++ flang/lib/semantics/CMakeLists.txt | 1 + flang/lib/semantics/expression.cc | 17 +++- flang/lib/semantics/semantics.cc | 17 ++-- flang/lib/semantics/semantics.h | 6 +- flang/test/semantics/CMakeLists.txt | 1 + flang/test/semantics/structconst03.f90 | 178 +++++++++++++++++++++++++++++++++ 7 files changed, 215 insertions(+), 12 deletions(-) create mode 100644 flang/test/semantics/structconst03.f90 diff --git a/flang/lib/evaluate/variable.h b/flang/lib/evaluate/variable.h index e2432a5..c51fafc 100644 --- a/flang/lib/evaluate/variable.h +++ b/flang/lib/evaluate/variable.h @@ -55,6 +55,13 @@ struct BaseObject { Expr LEN() const; bool operator==(const BaseObject &) const; std::ostream &AsFortran(std::ostream &) const; + const Symbol *symbol() const { + if (const auto *result{std::get_if(&u)}) { + return *result; + } else { + return nullptr; + } + } std::variant u; }; diff --git a/flang/lib/semantics/CMakeLists.txt b/flang/lib/semantics/CMakeLists.txt index 0f55e85..afa1f09 100644 --- a/flang/lib/semantics/CMakeLists.txt +++ b/flang/lib/semantics/CMakeLists.txt @@ -25,6 +25,7 @@ add_library(FortranSemantics scope.cc semantics.cc symbol.cc + tools.cc type.cc unparse-with-symbols.cc ) diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc index c970416..735d08e 100644 --- a/flang/lib/semantics/expression.cc +++ b/flang/lib/semantics/expression.cc @@ -16,6 +16,7 @@ #include "scope.h" #include "semantics.h" #include "symbol.h" +#include "tools.h" #include "../common/idioms.h" #include "../evaluate/common.h" #include "../evaluate/fold.h" @@ -1484,12 +1485,23 @@ static MaybeExpr AnalyzeExpr(ExpressionAnalysisContext &context, } } else { CHECK(symbol->has()); + // C1594(4) + if (!isNULL) { + const auto &innermost{context.context().FindScope(expr.source)}; + if (const auto *pureFunc{ + semantics::FindPureFunctionContaining(&innermost)}) { + if (semantics::IsOrHasPointerComponent(*symbol) && + semantics::IsExternallyVisibleObject(*value, *pureFunc)) { + context.Say(expr.source, + "Externally visible object must not be associated with a pointer in a PURE function"_err_en_US); + } + } + } if (symbol->attrs().test(semantics::Attr::POINTER)) { if (!isNULL) { // TODO C7104: check that object pointer components are // being initialized with compatible object designators - context.Say(expr.source, - "TODO: non-null object pointer component value not implemented yet"_err_en_US); + // TODO pmk WIP this is next } } else if (MaybeExpr converted{ ConvertToType(*symbol, std::move(*value))}) { @@ -1527,7 +1539,6 @@ static MaybeExpr AnalyzeExpr(ExpressionAnalysisContext &context, } } - // TODO pmk check type compatibility on component expressions return AsMaybeExpr(Expr{std::move(result)}); } diff --git a/flang/lib/semantics/semantics.cc b/flang/lib/semantics/semantics.cc index 516b37017..f47de1c 100644 --- a/flang/lib/semantics/semantics.cc +++ b/flang/lib/semantics/semantics.cc @@ -57,6 +57,15 @@ bool SemanticsContext::AnyFatalError() const { (warningsAreErrors_ || messages_.AnyFatalError()); } +const Scope &SemanticsContext::FindScope( + const parser::CharBlock &source) const { + if (const auto *scope{globalScope_.FindScope(source)}) { + return *scope; + } else { + common::die("invalid source location"); + } +} + bool Semantics::Perform() { ValidateLabels(context_.messages(), program_); if (AnyFatalError()) { @@ -82,14 +91,6 @@ bool Semantics::Perform() { return !AnyFatalError(); } -const Scope &Semantics::FindScope(const parser::CharBlock &source) const { - if (const auto *scope{context_.globalScope().FindScope(source)}) { - return *scope; - } else { - common::die("invalid source location"); - } -} - void Semantics::EmitMessages(std::ostream &os) const { context_.messages().Emit(os, cooked_); } diff --git a/flang/lib/semantics/semantics.h b/flang/lib/semantics/semantics.h index b37ac69..f949070 100644 --- a/flang/lib/semantics/semantics.h +++ b/flang/lib/semantics/semantics.h @@ -77,6 +77,8 @@ public: return messages_.Say(std::forward(args)...); } + const Scope &FindScope(const parser::CharBlock &) const; + private: const common::IntrinsicTypeDefaultKinds &defaultKinds_; std::vector searchDirectories_; @@ -99,7 +101,9 @@ public: SemanticsContext &context() const { return context_; } bool Perform(); - const Scope &FindScope(const parser::CharBlock &) const; + const Scope &FindScope(const parser::CharBlock &where) const { + return context_.FindScope(where); + } bool AnyFatalError() const { return context_.AnyFatalError(); } void EmitMessages(std::ostream &) const; void DumpSymbols(std::ostream &); diff --git a/flang/test/semantics/CMakeLists.txt b/flang/test/semantics/CMakeLists.txt index 74eda1e..00e6797 100644 --- a/flang/test/semantics/CMakeLists.txt +++ b/flang/test/semantics/CMakeLists.txt @@ -74,6 +74,7 @@ set(ERROR_TESTS resolve46.f90 structconst01.f90 structconst02.f90 + structconst03.f90 ) # These test files have expected symbols in the source diff --git a/flang/test/semantics/structconst03.f90 b/flang/test/semantics/structconst03.f90 new file mode 100644 index 0000000..c518382 --- /dev/null +++ b/flang/test/semantics/structconst03.f90 @@ -0,0 +1,178 @@ +! 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. + +! Error tests for structure constructors: C1594 violations +! from assigning globally-visible data to POINTER components. + +module usefrom + real :: usedfrom1 +end module usefrom + +module module1 + use usefrom + implicit none + type :: has_pointer1 + real, pointer :: p + type(has_pointer1), allocatable :: link1 + end type has_pointer1 + type :: has_pointer2 + type(has_pointer1) :: p + type(has_pointer2), allocatable :: link2 + end type has_pointer2 + type, extends(has_pointer2) :: has_pointer3 + type(has_pointer3), allocatable :: link3 + end type has_pointer3 + type :: t1(k) + integer, kind :: k + real, pointer :: p + type(t1(k)), allocatable :: link + end type t1 + type :: t2(k) + integer, kind :: k + type(has_pointer1) :: hp1 + type(t2(k)), allocatable :: link + end type t2 + type :: t3(k) + integer, kind :: k + type(has_pointer2) :: hp2 + type(t3(k)), allocatable :: link + end type t3 + type :: t4(k) + integer, kind :: k + type(has_pointer3) :: hp3 + type(t4(k)), allocatable :: link + end type t4 + real :: modulevar1 + real :: commonvar1 + type(has_pointer1) :: modulevar2, commonvar2 + type(has_pointer2) :: modulevar3, commonvar3 + type(has_pointer3) :: modulevar4, commonvar4 + common /cblock/ commonvar1 + + contains + + pure real function pf1(dummy1, dummy2, dummy3, dummy4) + real :: local1 + type(t1(0)) :: x1 + type(t2(0)) :: x2 + type(t3(0)) :: x3 + type(t4(0)) :: x4 + real, intent(in) :: dummy1 + real, intent(inout) :: dummy2 + real, pointer :: dummy3 + real, intent(inout) :: dummy4[*] + pf1 = 0. + x1 = t1(0)(local1) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x1 = t1(0)(usedfrom1) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x1 = t1(0)(modulevar1) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x1 = t1(0)(commonvar1) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x1 = t1(0)(dummy1) + x1 = t1(0)(dummy2) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x1 = t1(0)(dummy3) +! TODO when semantics handles coindexing: +! TODO !ERROR: Externally visible object must not be associated with a pointer in a PURE function +! TODO x1 = t1(0)(dummy4[0]) + x1 = t1(0)(dummy4) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x2 = t2(0)(modulevar2) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x2 = t2(0)(commonvar2) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x3 = t3(0)(modulevar3) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x3 = t3(0)(commonvar3) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x4 = t4(0)(modulevar4) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x4 = t4(0)(commonvar4) + contains + subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a) + real :: local1a + type(t1(0)) :: x1a + type(t2(0)) :: x2a + type(t3(0)) :: x3a + type(t4(0)) :: x4a + real, intent(in) :: dummy1a + real, intent(inout) :: dummy2a + real, pointer :: dummy3a + real, intent(inout) :: dummy4a[*] + x1a = t1(0)(local1a) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x1a = t1(0)(usedfrom1) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x1a = t1(0)(modulevar1) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x1a = t1(0)(commonvar1) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x1a = t1(0)(dummy1) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x1a = t1(0)(dummy1a) + x1a = t1(0)(dummy2a) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x1a = t1(0)(dummy3) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x1a = t1(0)(dummy3a) +! TODO when semantics handles coindexing: +! TODO !ERROR: Externally visible object must not be associated with a pointer in a PURE function +! TODO x1a = t1(0)(dummy4a[0]) + x1a = t1(0)(dummy4a) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x2a = t2(0)(modulevar2) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x2a = t2(0)(commonvar2) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x3a = t3(0)(modulevar3) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x3a = t3(0)(commonvar3) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x4a = t4(0)(modulevar4) + !ERROR: Externally visible object must not be associated with a pointer in a PURE function + x4a = t4(0)(commonvar4) + end subroutine subr + end function pf1 + + impure real function ipf1(dummy1, dummy2, dummy3, dummy4) + real :: local1 + type(t1(0)) :: x1 + type(t2(0)) :: x2 + type(t3(0)) :: x3 + type(t4(0)) :: x4 + real, intent(in) :: dummy1 + real, intent(inout) :: dummy2 + real, pointer :: dummy3 + real, intent(inout) :: dummy4[*] + ipf1 = 0. + x1 = t1(0)(local1) + x1 = t1(0)(usedfrom1) + x1 = t1(0)(modulevar1) + x1 = t1(0)(commonvar1) + x1 = t1(0)(dummy1) + x1 = t1(0)(dummy2) + x1 = t1(0)(dummy3) +! TODO when semantics handles coindexing: +! TODO x1 = t1(0)(dummy4[0]) + x1 = t1(0)(dummy4) + x2 = t2(0)(modulevar2) + x2 = t2(0)(commonvar2) + x3 = t3(0)(modulevar3) + x3 = t3(0)(commonvar3) + x4 = t4(0)(modulevar4) + x4 = t4(0)(commonvar4) + end function ipf1 +end module module1 -- 2.7.4