[flang] Name resolution bug fixes

Fix a but where a derived type was not use-associated correctly
due to missing call to `GetUltimate()`.

Fix a bug with access statement, generic interface, and derived
type all with the same name.

Remove some TODOs that have been done.

Original-commit: flang-compiler/f18@4ba2b64c6d291d04691891535da96f425dda2338
Reviewed-on: https://github.com/flang-compiler/f18/pull/372

diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc
index 5925e4a..514a6a3 100644 (file)
--- a/flang/lib/semantics/resolve-names.cc
+++ b/flang/lib/semantics/resolve-names.cc
@@ -349,7 +349,7 @@ private:
 // 2. INTEGER :: x(10)
 // 3. ALLOCATABLE :: x(:)
 // 4. DIMENSION :: x(10)
-// 5. TODO: COMMON x(10)
+// 5. COMMON x(10)
 // 6. TODO: BasedPointerStmt
 class ArraySpecVisitor : public virtual BaseVisitor {
 public:
@@ -1223,7 +1223,6 @@ bool DeclTypeSpecVisitor::Pre(const parser::TypeGuardStmt &) {
   return true;
 }
 void DeclTypeSpecVisitor::Post(const parser::TypeGuardStmt &) {
-  // TODO: TypeGuardStmt
   EndDeclTypeSpec();
 }
 
@@ -2009,6 +2008,11 @@ bool InterfaceVisitor::Pre(const parser::GenericSpec &x) {
       EraseSymbol(*genericSymbol_);
       genericSymbol_ = &MakeSymbol(symbolName);
       genericSymbol_->set_details(details);
+      // preserve access attributes
+      genericSymbol_->attrs() |=
+          details.derivedType()->attrs() & Attrs{Attr::PUBLIC, Attr::PRIVATE};
+    } else if (genericSymbol_->has<UnknownDetails>()) {
+      // okay
     } else if (!genericSymbol_->IsSubprogram()) {
       SayAlreadyDeclared(symbolName, *genericSymbol_);
       EraseSymbol(*genericSymbol_);
@@ -2027,7 +2031,7 @@ bool InterfaceVisitor::Pre(const parser::GenericSpec &x) {
       }
     }
   }
-  if (!genericSymbol_) {
+  if (!genericSymbol_ || genericSymbol_->has<UnknownDetails>()) {
     genericSymbol_ = &MakeSymbol(symbolName);
     genericSymbol_->set_details(GenericDetails{});
   }
@@ -2555,7 +2559,7 @@ void DeclarationVisitor::Post(const parser::DimensionStmt::Declaration &x) {
 void DeclarationVisitor::Post(const parser::EntityDecl &x) {
   // TODO: may be under StructureStmt
   const auto &name{std::get<parser::ObjectName>(x.t)};
-  // TODO: CoarraySpec, CharLength, Initialization
+  // TODO: CoarraySpec
   Attrs attrs{attrs_ ? HandleSaveName(name.source, *attrs_) : Attrs{}};
   Symbol &symbol{DeclareUnknownEntity(name, attrs)};
   if (auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) {
@@ -3745,9 +3749,7 @@ const Symbol *DeclarationVisitor::ResolveDerivedType(const parser::Name &name) {
   if (CheckUseError(name)) {
     return nullptr;
   }
-  if (auto *details{symbol->detailsIf<UseDetails>()}) {
-    symbol = &details->symbol();
-  }
+  symbol = &symbol->GetUltimate();
   if (auto *details{symbol->detailsIf<GenericDetails>()}) {
     if (details->derivedType()) {
       symbol = details->derivedType();

diff --git a/flang/test/semantics/CMakeLists.txt b/flang/test/semantics/CMakeLists.txt
index 932421a..2a4ae11 100644 (file)
--- a/flang/test/semantics/CMakeLists.txt
+++ b/flang/test/semantics/CMakeLists.txt
@@ -74,6 +74,7 @@ set(ERROR_TESTS
   resolve45.f90
   resolve46.f90
   resolve47.f90
+  resolve48.f90
   structconst01.f90
   structconst02.f90
   structconst03.f90

diff --git a/flang/test/semantics/resolve48.f90 b/flang/test/semantics/resolve48.f90
new file mode 100644 (file)
index 0000000..6e25fd5
--- /dev/null
+++ b/flang/test/semantics/resolve48.f90
@@ -0,0 +1,48 @@
+! 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 correct use-association of a derived type.
+module m1
+  implicit none
+  type :: t
+  end type
+end module
+module m2
+  use m1, only: t
+end module
+module m3
+  use m2
+  type(t) :: o
+end
+
+! Test access-stmt with generic interface and type of same name.
+module m4
+  private
+  public :: t1, t2
+  type :: t2
+  end type
+  interface t1
+    module procedure init1
+  end interface
+  interface t2
+    module procedure init2
+  end interface
+  type :: t1
+  end type
+contains
+  type(t1) function init1()
+  end function
+  type(t2) function init2()
+  end function
+end module