From: Tim Keith <tkeith@nvidia.com>
Date: Thu, 6 Sep 2018 19:06:32 +0000 (-0700)
Subject: [flang] Add procedure pointer components for derived types
X-Git-Tag: llvmorg-12-init~9537^2~2238
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=b168cc0b8386b676f9433a6990df43610c3a5875;p=platform%2Fupstream%2Fllvm.git

[flang] Add procedure pointer components for derived types

Also eliminate `derivedTypeData_`. Information about derived types needed
during name resolution is in `derivedTypeInfo_` and the permanent record
is the symbol table.

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

diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc
index 005cf89..d9d3cd2f 100644
--- a/flang/lib/semantics/resolve-names.cc
+++ b/flang/lib/semantics/resolve-names.cc
@@ -526,7 +526,6 @@ public:
   void Post(const parser::DeclarationTypeSpec::Type &);
   void Post(const parser::DeclarationTypeSpec::Class &);
   bool Pre(const parser::DerivedTypeSpec &);
-  bool Pre(const parser::DerivedTypeDef &x);
   void Post(const parser::DerivedTypeDef &x);
   bool Pre(const parser::DerivedTypeStmt &x);
   void Post(const parser::DerivedTypeStmt &x);
@@ -567,8 +566,6 @@ private:
     bool sawContains{false};  // currently processing bindings
     bool sequence{false};  // is a sequence type
   } derivedTypeInfo_;
-  // In a DerivedTypeDef, this is data collected for it
-  std::unique_ptr<DerivedTypeDef::Data> derivedTypeData_;
   // In a ProcedureDeclarationStmt or ProcComponentDefStmt, this is
   // the interface name, if any.
   const SourceName *interfaceName_{nullptr};
@@ -1997,7 +1994,6 @@ void DeclarationVisitor::DeclareProcEntity(
               : Symbol::Flag::Subroutine);
     }
     details->set_interface(interface);
-    symbol.attrs().set(Attr::EXTERNAL);
   }
 }
 
@@ -2045,13 +2041,7 @@ bool DeclarationVisitor::Pre(const parser::DerivedTypeSpec &x) {
   BeginDerivedTypeSpec(derivedTypeSpec);
   return true;
 }
-bool DeclarationVisitor::Pre(const parser::DerivedTypeDef &x) {
-  CHECK(!derivedTypeData_);
-  derivedTypeData_ = std::make_unique<DerivedTypeDef::Data>();
-  return true;
-}
 void DeclarationVisitor::Post(const parser::DerivedTypeDef &x) {
-  derivedTypeData_.reset();
   std::set<SourceName> paramNames;
   auto &scope{currScope()};
   auto &stmt{std::get<parser::Statement<parser::DerivedTypeStmt>>(x.t)};
@@ -2133,7 +2123,6 @@ void DeclarationVisitor::Post(const parser::TypeParamDefStmt &x) {
 }
 bool DeclarationVisitor::Pre(const parser::TypeAttrSpec::Extends &x) {
   derivedTypeInfo_.extends = &x.v.source;
-  derivedTypeData_->extends = &x.v.source;
   return false;
 }
 
@@ -2153,7 +2142,6 @@ bool DeclarationVisitor::Pre(const parser::PrivateStmt &x) {
 }
 bool DeclarationVisitor::Pre(const parser::SequenceStmt &x) {
   derivedTypeInfo_.sequence = true;
-  derivedTypeData_->sequence = true;
   return false;
 }
 void DeclarationVisitor::Post(const parser::ComponentDecl &x) {
@@ -2197,12 +2185,11 @@ void DeclarationVisitor::Post(const parser::ProcDecl &x) {
   } else if (auto &type{GetDeclTypeSpec()}) {
     interface.set_type(*type);
   }
-  if (derivedTypeData_) {
-    derivedTypeData_->procComps.emplace_back(
-        ProcDecl{name.source}, GetAttrs(), interface);
-  } else {
-    DeclareProcEntity(name, GetAttrs(), interface);
+  auto attrs{GetAttrs()};
+  if (currScope().kind() != Scope::Kind::DerivedType) {
+    attrs.set(Attr::EXTERNAL);
   }
+  DeclareProcEntity(name, attrs, interface);
 }
 
 bool DeclarationVisitor::Pre(const parser::TypeBoundProcedurePart &x) {
diff --git a/flang/test/semantics/modfile08.f90 b/flang/test/semantics/modfile08.f90
index de042c9..3f49979 100644
--- a/flang/test/semantics/modfile08.f90
+++ b/flang/test/semantics/modfile08.f90
@@ -21,14 +21,34 @@ module m
   external b, d
   procedure() :: e
   procedure(real) :: f
+  procedure(s) :: g
+  type t
+    procedure(), pointer, nopass :: e
+    procedure(real), nopass, pointer :: f
+    procedure(s), private, pointer :: g
+  end type
+contains
+  subroutine s(x)
+    class(t) :: x
+  end
 end
 
 !Expect: m.mod
 !module m
-! procedure(real)::a
-! procedure(logical)::b
-! procedure(complex)::c
-! procedure()::d
-! procedure()::e
-! procedure(real)::f
+!  procedure(real)::a
+!  procedure(logical)::b
+!  procedure(complex)::c
+!  procedure()::d
+!  procedure()::e
+!  procedure(real)::f
+!  procedure(s)::g
+!  type::t
+!    procedure(),nopass,pointer::e
+!    procedure(real),nopass,pointer::f
+!    procedure(s),pointer,private::g
+!  end type
+!contains
+!  subroutine s(x)
+!    class(t)::x
+!  end
 !end