[flang] Fix generic/specific procedure confusion

A recent change that extended semantic analysis for actual arguments
that associate with procedure dummy arguments exposed some bugs in
regression test suites due to points of confusion in symbol table
handling in situations where a generic interface contains a specific
procedure of the same name.  When passing that name as an actual
argument, for example, it's necessary to take this possibility into
account because the symbol for the generic interface shadows the
symbol of the same name for the specific procedure, which is
what needs to be checked.  So add a small utility that bypasses
the symbol for a generic interface in this case, and use it
where needed.

Differential Revision: https://reviews.llvm.org/D104929

flang/include/flang/Parser/parse-tree.h

@@ -1779,7 +1779,7 @@ struct Designator {
 struct Variable {
   UNION_CLASS_BOILERPLATE(Variable);
   mutable TypedExpr typedExpr;
-  parser::CharBlock GetSource() const;
+  CharBlock GetSource() const;
   std::variant<common::Indirection<Designator>,
       common::Indirection<FunctionReference>>
       u;

flang/include/flang/Semantics/tools.h

@@ -252,6 +252,10 @@ const Symbol *FindExternallyVisibleObject(
       expr.u);
 }
 
+// Apply GetUltimate(), then if the symbol is a generic procedure shadowing a
+// specific procedure of the same name, return it instead.
+const Symbol &BypassGeneric(const Symbol &);
+
 using SomeExpr = evaluate::Expr<evaluate::SomeType>;
 
 bool ExprHasTypeCategory(

flang/lib/Evaluate/fold-reduction.h

@@ -139,7 +139,7 @@ static Expr<T> FoldMaxvalMinval(FoldingContext &context, FunctionRef<T> &&ref,
   static_assert(T::category == TypeCategory::Integer ||
       T::category == TypeCategory::Real ||
       T::category == TypeCategory::Character);
-  using Element = Scalar<T>; // pmk: was typename Constant<T>::Element;
+  using Element = Scalar<T>;
   std::optional<ConstantSubscript> dim;
   if (std::optional<Constant<T>> array{
           ProcessReductionArgs<T>(context, ref.arguments(), dim, identity,

flang/lib/Semantics/expression.cpp

@@ -175,14 +175,18 @@ private:
 // or procedure pointer reference in a ProcedureDesignator.
 MaybeExpr ExpressionAnalyzer::Designate(DataRef &&ref) {
   const Symbol &last{ref.GetLastSymbol()};
-  const Symbol &symbol{last.GetUltimate()};
+  const Symbol &symbol{BypassGeneric(last).GetUltimate()};
   if (semantics::IsProcedure(symbol)) {
     if (auto *component{std::get_if<Component>(&ref.u)}) {
       return Expr<SomeType>{ProcedureDesignator{std::move(*component)}};
     } else if (!std::holds_alternative<SymbolRef>(ref.u)) {
       DIE("unexpected alternative in DataRef");
     } else if (!symbol.attrs().test(semantics::Attr::INTRINSIC)) {
+      if (symbol.has<semantics::GenericDetails>()) {
+        Say("'%s' is not a specific procedure"_err_en_US, symbol.name());
+      } else {
         return Expr<SomeType>{ProcedureDesignator{symbol}};
+      }
     } else if (auto interface{context_.intrinsics().IsSpecificIntrinsicFunction(
                    symbol.name().ToString())}) {
       SpecificIntrinsic intrinsic{
@@ -3117,8 +3121,6 @@ void ArgumentAnalyzer::Analyze(
   std::optional<ActualArgument> actual;
   std::visit(common::visitors{
                  [&](const common::Indirection<parser::Expr> &x) {
-                   // TODO: Distinguish & handle procedure name and
-                   // proc-component-ref
                    actual = AnalyzeExpr(x.value());
                  },
                  [&](const parser::AltReturnSpec &label) {

flang/lib/Semantics/resolve-names.cpp

@@ -2751,7 +2751,7 @@ void InterfaceVisitor::ResolveSpecificsInGeneric(Symbol &generic) {
   auto &details{generic.get<GenericDetails>()};
   UnorderedSymbolSet symbolsSeen;
   for (const Symbol &symbol : details.specificProcs()) {
-    symbolsSeen.insert(symbol);
+    symbolsSeen.insert(symbol.GetUltimate());
   }
   auto range{specificProcs_.equal_range(&generic)};
   for (auto it{range.first}; it != range.second; ++it) {
@@ -2762,12 +2762,8 @@ void InterfaceVisitor::ResolveSpecificsInGeneric(Symbol &generic) {
       Say(*name, "Procedure '%s' not found"_err_en_US);
       continue;
     }
-    if (symbol == &generic) {
-      if (auto *specific{generic.get<GenericDetails>().specific()}) {
-        symbol = specific;
-      }
-    }
-    const Symbol &ultimate{symbol->GetUltimate()};
+    const Symbol &specific{BypassGeneric(*symbol)};
+    const Symbol &ultimate{specific.GetUltimate()};
     if (!ultimate.has<SubprogramDetails>() &&
         !ultimate.has<SubprogramNameDetails>()) {
       Say(*name, "'%s' is not a subprogram"_err_en_US);
@@ -2788,8 +2784,12 @@ void InterfaceVisitor::ResolveSpecificsInGeneric(Symbol &generic) {
         }
       }
     }
-    if (!symbolsSeen.insert(ultimate).second) {
-      if (symbol == &ultimate) {
+    if (symbolsSeen.insert(ultimate).second /*true if added*/) {
+      // When a specific procedure is a USE association, that association
+      // is saved in the generic's specifics, not its ultimate symbol,
+      // so that module file output of interfaces can distinguish them.
+      details.AddSpecificProc(specific, name->source);
+    } else if (&specific == &ultimate) {
       Say(name->source,
           "Procedure '%s' is already specified in generic '%s'"_err_en_US,
           name->source, MakeOpName(generic.name()));
@@ -2799,9 +2799,6 @@ void InterfaceVisitor::ResolveSpecificsInGeneric(Symbol &generic) {
           ultimate.name(), ultimate.owner().GetName().value(),
           MakeOpName(generic.name()));
     }
-      continue;
-    }
-    details.AddSpecificProc(*symbol, name->source);
   }
   specificProcs_.erase(range.first, range.second);
 }

flang/lib/Semantics/tools.cpp

@@ -359,6 +359,16 @@ const Symbol *FindExternallyVisibleObject(
   return nullptr;
 }
 
+const Symbol &BypassGeneric(const Symbol &symbol) {
+  const Symbol &ultimate{symbol.GetUltimate()};
+  if (const auto *generic{ultimate.detailsIf<GenericDetails>()}) {
+    if (const Symbol * specific{generic->specific()}) {
+      return *specific;
+    }
+  }
+  return symbol;
+}
+
 bool ExprHasTypeCategory(
     const SomeExpr &expr, const common::TypeCategory &type) {
   auto dynamicType{expr.GetType()};

flang/runtime/type-info.h

@@ -82,8 +82,7 @@ private:
       lenParameterKind_; // pointer to rank-1 array of INTEGER(1)
 
   // This array of local data components includes the parent component.
-  // Components are in alphabetic order.
-  // TODO pmk: fix to be "component order"
+  // Components are in component order, not collation order of their names.
   // It does not include procedure pointer components.
   StaticDescriptor<1, true>
       component_; // TYPE(COMPONENT), POINTER, DIMENSION(:), CONTIGUOUS