From: peter klausler Date: Sat, 16 Feb 2019 00:08:32 +0000 (-0800) Subject: [flang] fix flang-compiler/f18#283 - recursive use of derived types X-Git-Tag: llvmorg-12-init~9537^2~1771 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=88631be8b4664c9f8d5c28f8dbe18800fd252f19;p=platform%2Fupstream%2Fllvm.git [flang] fix flang-compiler/f18#283 - recursive use of derived types Original-commit: flang-compiler/f18@f8889b83fcca8630c773dc52482b8236a30254c9 Reviewed-on: https://github.com/flang-compiler/f18/pull/291 Tree-same-pre-rewrite: false --- diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc index 05b87ec..f159c1f 100644 --- a/flang/lib/semantics/resolve-names.cc +++ b/flang/lib/semantics/resolve-names.cc @@ -664,7 +664,7 @@ public: bool Pre(const parser::DeclarationTypeSpec::Class &); bool Pre(const parser::DeclarationTypeSpec::Record &); void Post(const parser::DerivedTypeSpec &); - void Post(const parser::DerivedTypeDef &x); + bool Pre(const parser::DerivedTypeDef &); bool Pre(const parser::DerivedTypeStmt &x); void Post(const parser::DerivedTypeStmt &x); bool Pre(const parser::TypeParamDefStmt &x) { return BeginDecl(); } @@ -674,7 +674,7 @@ public: bool Pre(const parser::SequenceStmt &x); bool Pre(const parser::ComponentDefStmt &) { return BeginDecl(); } void Post(const parser::ComponentDefStmt &) { EndDecl(); } - void Post(const parser::ComponentDecl &x); + void Post(const parser::ComponentDecl &); bool Pre(const parser::ProcedureDeclarationStmt &); void Post(const parser::ProcedureDeclarationStmt &); bool Pre(const parser::ProcComponentDefStmt &); @@ -682,6 +682,7 @@ public: void Post(const parser::ProcInterface &x); void Post(const parser::ProcDecl &x); bool Pre(const parser::TypeBoundProcedurePart &); + void Post(const parser::ContainsStmt &); bool Pre(const parser::TypeBoundProcBinding &) { return BeginAttrs(); } void Post(const parser::TypeBoundProcBinding &) { EndAttrs(); } void Post(const parser::TypeBoundProcedureStmt::WithoutInterface &); @@ -725,13 +726,14 @@ private: std::optional length; std::optional kind; } charInfo_; - // Info about current derived type while walking DerivedTypeStmt + // Info about current derived type while walking DerivedTypeDef struct { const parser::Name *extends{nullptr}; // EXTENDS(name) bool privateComps{false}; // components are private by default bool privateBindings{false}; // bindings are private by default bool sawContains{false}; // currently processing bindings bool sequence{false}; // is a sequence type + const Symbol *type{nullptr}; // derived type being defined } derivedTypeInfo_; // Info about common blocks in the current scope struct { @@ -2809,13 +2811,18 @@ void DeclarationVisitor::Post(const parser::DerivedTypeSpec &x) { x.derivedTypeSpec = &GetDeclTypeSpec()->derivedTypeSpec(); } -void DeclarationVisitor::Post(const parser::DerivedTypeDef &x) { - std::set paramNames; +// The descendents of DerivedTypeDef in the parse tree are visited directly +// in this Pre() routine so that recursive use of the derived type can be +// supported in the components. +bool DeclarationVisitor::Pre(const parser::DerivedTypeDef &x) { + Walk(std::get>(x.t)); + Walk(std::get>>(x.t)); auto &scope{currScope()}; CHECK(scope.symbol() != nullptr); CHECK(scope.symbol()->scope() == &scope); auto &details{scope.symbol()->get()}; auto &stmt{std::get>(x.t)}; + std::set paramNames; for (auto ¶mName : std::get>(stmt.statement.t)) { details.add_paramName(paramName.source); auto *symbol{FindInScope(scope, paramName)}; @@ -2838,6 +2845,7 @@ void DeclarationVisitor::Post(const parser::DerivedTypeDef &x) { currScope()); // C742 } } + Walk(std::get>>(x.t)); if (derivedTypeInfo_.sequence) { details.set_sequence(true); if (derivedTypeInfo_.extends) { @@ -2848,13 +2856,13 @@ void DeclarationVisitor::Post(const parser::DerivedTypeDef &x) { Say(stmt.source, "A sequence type may not have type parameters"_err_en_US); // C740 } - if (derivedTypeInfo_.sawContains) { - Say(stmt.source, - "A sequence type may not have a CONTAINS statement"_err_en_US); // C740 - } } + Walk(std::get>>(x.t)); + Walk(std::get>(x.t)); + Walk(std::get>(x.t)); derivedTypeInfo_ = {}; PopScope(); + return false; } bool DeclarationVisitor::Pre(const parser::DerivedTypeStmt &x) { return BeginAttrs(); @@ -2862,6 +2870,7 @@ bool DeclarationVisitor::Pre(const parser::DerivedTypeStmt &x) { void DeclarationVisitor::Post(const parser::DerivedTypeStmt &x) { auto &name{std::get(x.t)}; auto &symbol{MakeSymbol(name, GetAttrs(), DerivedTypeDetails{})}; + derivedTypeInfo_.type = &symbol; PushScope(Scope::Kind::DerivedType, &symbol); if (auto *extendsName{derivedTypeInfo_.extends}) { if (const Symbol * extends{ResolveDerivedType(*extendsName)}) { @@ -2931,6 +2940,16 @@ void DeclarationVisitor::Post(const parser::ComponentDecl &x) { !attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) { attrs.set(Attr::PRIVATE); } + if (!attrs.HasAny({Attr::POINTER, Attr::ALLOCATABLE})) { + if (const auto *declType{GetDeclTypeSpec()}) { + if (const auto *derived{declType->AsDerived()}) { + if (derivedTypeInfo_.type == &derived->typeSymbol()) { // C737 + Say("Recursive use of the derived type requires " + "POINTER or ALLOCATABLE"_err_en_US); + } + } + } + } if (OkToAddComponent(name)) { auto &symbol{DeclareObjectEntity(name, attrs)}; if (auto *details{symbol.detailsIf()}) { @@ -2987,6 +3006,12 @@ bool DeclarationVisitor::Pre(const parser::TypeBoundProcedurePart &x) { return true; } +void DeclarationVisitor::Post(const parser::ContainsStmt &) { + if (derivedTypeInfo_.sequence) { + Say("A sequence type may not have a CONTAINS statement"_err_en_US); // C740 + } +} + void DeclarationVisitor::Post( const parser::TypeBoundProcedureStmt::WithoutInterface &x) { if (GetAttrs().test(Attr::DEFERRED)) { // C783 diff --git a/flang/test/semantics/CMakeLists.txt b/flang/test/semantics/CMakeLists.txt index c275160..016ac62 100644 --- a/flang/test/semantics/CMakeLists.txt +++ b/flang/test/semantics/CMakeLists.txt @@ -69,6 +69,7 @@ set(ERROR_TESTS resolve41.f90 resolve42.f90 resolve43.f90 + resolve44.f90 structconst01.f90 ) diff --git a/flang/test/semantics/resolve31.f90 b/flang/test/semantics/resolve31.f90 index 9e3f800..b0d745d 100644 --- a/flang/test/semantics/resolve31.f90 +++ b/flang/test/semantics/resolve31.f90 @@ -60,10 +60,10 @@ module m4 sequence integer i end type - !ERROR: A sequence type may not have a CONTAINS statement type :: t3 sequence integer i + !ERROR: A sequence type may not have a CONTAINS statement contains end type contains diff --git a/flang/test/semantics/resolve33.f90 b/flang/test/semantics/resolve33.f90 index f5bc58b..833580d 100644 --- a/flang/test/semantics/resolve33.f90 +++ b/flang/test/semantics/resolve33.f90 @@ -25,7 +25,7 @@ module m integer, kind :: a integer, len :: c end type - !ERROR: 'b' is not defined as a type parameter + !ERROR: No definition found for type parameter 'b' type t3(a, b) integer, kind :: a integer :: b diff --git a/flang/test/semantics/resolve44.f90 b/flang/test/semantics/resolve44.f90 new file mode 100644 index 0000000..13bdf06 --- /dev/null +++ b/flang/test/semantics/resolve44.f90 @@ -0,0 +1,40 @@ +! 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 recursive use of derived types. + +program main + type :: recursive1 + !ERROR: Recursive use of the derived type requires POINTER or ALLOCATABLE + type(recursive1) :: bad + type(recursive1), pointer :: ok1 + type(recursive1), allocatable :: ok2 + end type recursive1 + type :: recursive2(kind,len) + integer, kind :: kind + integer, len :: len + !ERROR: Recursive use of the derived type requires POINTER or ALLOCATABLE + type(recursive2(kind,len)) :: bad + type(recursive2(kind,len)), pointer :: ok1 + type(recursive2(kind,len)), allocatable :: ok2 + end type recursive2 + type :: recursive3(kind,len) + integer, kind :: kind = 1 + integer, len :: len = 2 + !ERROR: Recursive use of the derived type requires POINTER or ALLOCATABLE + type(recursive3) :: bad + type(recursive3), pointer :: ok1 + type(recursive3), allocatable :: ok2 + end type recursive3 +end program main