[flang] Address remaining initial comments

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

flang/lib/semantics/check-call.cc

@@ -13,6 +13,7 @@
 // limitations under the License.
 
 #include "check-call.h"
+#include "check-declarations.h"
 #include "scope.h"
 #include "tools.h"
 #include "../evaluate/characteristics.h"
@@ -75,41 +76,6 @@ static void CheckImplicitInterfaceArg(
   }
 }
 
-struct TypeConcerns {
-  const Symbol *typeBoundProcedure{nullptr};
-  const Symbol *finalProcedure{nullptr};
-  const Symbol *allocatable{nullptr};
-  const Symbol *coarray{nullptr};
-};
-
-static void InspectType(
-    const DerivedTypeSpec &derived, TypeConcerns &concerns) {
-  if (const auto *scope{derived.typeSymbol().scope()}) {
-    for (const auto &pair : *scope) {
-      const Symbol &component{*pair.second};
-      if (const auto *object{component.detailsIf<ObjectEntityDetails>()}) {
-        if (component.attrs().test(Attr::ALLOCATABLE)) {
-          concerns.allocatable = &component;
-        }
-        if (object->IsCoarray()) {
-          concerns.coarray = &component;
-        }
-        if (component.flags().test(Symbol::Flag::ParentComp)) {
-          if (const auto *type{object->type()}) {
-            if (const auto *parent{type->AsDerived()}) {
-              InspectType(*parent, concerns);
-            }
-          }
-        }
-      } else if (component.has<ProcBindingDetails>()) {
-        concerns.typeBoundProcedure = &component;
-      } else if (component.has<FinalProcDetails>()) {
-        concerns.finalProcedure = &component;
-      }
-    }
-  }
-}
-
 // When scalar CHARACTER actual arguments are known to be short,
 // we extend them on the right with spaces and a warning.
 static void PadShortCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
@@ -186,48 +152,48 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
   if (!actualType.type().IsUnlimitedPolymorphic() &&
       actualType.type().category() == TypeCategory::Derived) {
     const auto &derived{actualType.type().GetDerivedTypeSpec()};
-    TypeConcerns concerns;
-    InspectType(derived, concerns);
+    TypeInspector inspector;
+    inspector.Inspect(derived);
     if (dummy.type.type().IsAssumedType()) {
       if (!derived.parameters().empty()) {  // 15.5.2.4(2)
         messages.Say(
             "Actual argument associated with TYPE(*) %s may not have a parameterized derived type"_err_en_US,
             dummyName);
       }
-      if (concerns.typeBoundProcedure) {  // 15.5.2.4(2)
+      if (inspector.typeBoundProcedure()) {  // 15.5.2.4(2)
         if (auto *msg{messages.Say(
                 "Actual argument associated with TYPE(*) %s may not have type-bound procedures"_err_en_US,
                 dummyName)}) {
-          msg->Attach(concerns.typeBoundProcedure->name(),
+          msg->Attach(inspector.typeBoundProcedure()->name(),
               "Declaration of type-bound procedure"_en_US);
         }
       }
-      if (concerns.finalProcedure) {  // 15.5.2.4(2)
+      if (inspector.finalProcedure()) {  // 15.5.2.4(2)
         if (auto *msg{messages.Say(
                 "Actual argument associated with TYPE(*) %s may not have FINAL procedures"_err_en_US,
                 dummyName)}) {
-          msg->Attach(concerns.finalProcedure->name(),
+          msg->Attach(inspector.finalProcedure()->name(),
               "Declaration of FINAL procedure"_en_US);
         }
       }
     }
-    if (actualIsCoindexed && concerns.allocatable &&
+    if (actualIsCoindexed && inspector.allocatable() &&
         dummy.intent != common::Intent::In && !dummyIsValue) {
       // 15.5.2.4(6)
       if (auto *msg{messages.Say(
               "Coindexed actual argument with ALLOCATABLE ultimate component must be associated with a %s with VALUE or INTENT(IN) attributes"_err_en_US,
               dummyName)}) {
-        msg->Attach(concerns.allocatable->name(),
+        msg->Attach(inspector.allocatable()->name(),
             "Declaration of ALLOCATABLE component"_en_US);
       }
     }
-    if (concerns.coarray &&
+    if (inspector.coarray() &&
         actualIsVolatile != dummyIsVolatile) {  // 15.5.2.4(22)
       if (auto *msg{messages.Say(
               "VOLATILE attribute must match for %s when actual argument has a coarray ultimate component"_err_en_US,
               dummyName)}) {
-        msg->Attach(
-            concerns.coarray->name(), "Declaration of coarray component"_en_US);
+        msg->Attach(inspector.coarray()->name(),
+            "Declaration of coarray component"_en_US);
       }
     }
   }

flang/lib/semantics/check-declarations.cc

@@ -119,4 +119,51 @@ void CheckHelper::Check(Symbol &symbol) {
 void CheckDeclarations(SemanticsContext &context) {
   CheckHelper{context}.Check();
 }
+
+TypeInspector::TypeInspector() {}
+TypeInspector::~TypeInspector() {}
+
+void TypeInspector::Inspect(const DerivedTypeSpec &derived) {
+  Inspect(derived, true);
+}
+
+void TypeInspector::Inspect(
+    const DerivedTypeSpec &derived, bool inParentChain) {
+  if (inspected_.insert(&derived).second) {
+    if (const auto *parent{
+            derived.typeSymbol().GetParentTypeSpec(derived.scope())}) {
+      Inspect(*parent, inParentChain);
+    }
+    if (const auto *scope{derived.typeSymbol().scope()}) {
+      for (const auto &pair : *scope) {
+        Inspect(*pair.second, inParentChain);
+      }
+    }
+  }
+}
+
+void TypeInspector::Inspect(const Symbol &component, bool inParentChain) {
+  if (const auto *object{component.detailsIf<ObjectEntityDetails>()}) {
+    if (component.attrs().test(Attr::ALLOCATABLE)) {
+      allocatable_ = &component;
+    }
+    if (object->IsCoarray()) {
+      coarray_ = &component;
+      if (component.attrs().test(Attr::ALLOCATABLE)) {
+        allocatableCoarray_ = &component;
+      }
+    }
+    if (const auto *type{object->type()}) {
+      if (const auto *nested{type->AsDerived()}) {
+        Inspect(*nested, false);
+      }
+    }
+  } else if (inParentChain) {
+    if (component.has<ProcBindingDetails>()) {
+      typeBoundProcedure_ = &component;
+    } else if (component.has<FinalProcDetails>()) {
+      finalProcedure_ = &component;
+    }
+  }
+}
 }

flang/lib/semantics/check-declarations.h

@@ -16,8 +16,37 @@
 
 #ifndef FORTRAN_SEMANTICS_CHECK_DECLARATIONS_H_
 #define FORTRAN_SEMANTICS_CHECK_DECLARATIONS_H_
+
+#include <set>
+
 namespace Fortran::semantics {
+class DerivedTypeSpec;
 class SemanticsContext;
+class Symbol;
+
 void CheckDeclarations(SemanticsContext &);
+
+class TypeInspector {
+public:
+  TypeInspector();
+  ~TypeInspector();
+  const Symbol *typeBoundProcedure() const { return typeBoundProcedure_; }
+  const Symbol *finalProcedure() const { return finalProcedure_; }
+  const Symbol *allocatable() const { return allocatable_; }
+  const Symbol *coarray() const { return coarray_; }
+  const Symbol *allocatableCoarray() const { return allocatableCoarray_; }
+  void Inspect(const DerivedTypeSpec &);
+
+private:
+  void Inspect(const DerivedTypeSpec &, bool inParentChain);
+  void Inspect(const Symbol &, bool inParentChain);
+
+  const Symbol *typeBoundProcedure_{nullptr};
+  const Symbol *finalProcedure_{nullptr};
+  const Symbol *allocatable_{nullptr};
+  const Symbol *coarray_{nullptr};
+  const Symbol *allocatableCoarray_{nullptr};
+  std::set<const DerivedTypeSpec *> inspected_;
+};
 }
 #endif