[flang] Make generic resolution conform to 15.5.5.2 w/r/t host association

[klausler]

Summary

When two or more generic interfaces are available by declaration or
by USE association at different scoping levels, we need to search
the outer generic interfaces as well as the inner ones, but only after
the inner ones have failed to produce a specific procedure that matches
a given set of actual arguments. This means that it is possible for
a specific procedure of a generic interface of an inner scope to override
a conflicting specific procedure of a generic interface of an outer
scope.

[klausler]

Add missing changes (a cherry-pick went awry).

flang/include/flang/Semantics/expression.h

struct CalleeAndArguments {
     // A non-component function reference may constitute a misparsed
     // structure constructor, in which case its derived type's Symbol
     // will appear here.
     std::variant<ProcedureDesignator, SymbolRef> u;
     ActualArguments arguments;
   };
 
   std::optional<CalleeAndArguments> AnalyzeProcedureComponentRef(
-      const parser::ProcComponentRef &, ActualArguments &&);
+      const parser::ProcComponentRef &, ActualArguments &&, bool isSubroutine);
   std::optional<characteristics::Procedure> CheckCall(
       parser::CharBlock, const ProcedureDesignator &, ActualArguments &);
   using AdjustActuals =
       std::optional<std::function<bool(const Symbol &, ActualArguments &)>>;
   bool ResolveForward(const Symbol &);
   std::pair<const Symbol *, bool /* failure due to NULL() actuals */>
   ResolveGeneric(const Symbol &, const ActualArguments &, const AdjustActuals &,
-      bool mightBeStructureConstructor = false);
+      bool isSubroutine, bool mightBeStructureConstructor = false);
   void EmitGenericResolutionError(const Symbol &, bool dueToNullActuals);
   const Symbol &AccessSpecific(
       const Symbol &originalGeneric, const Symbol &specific);
   std::optional<CalleeAndArguments> GetCalleeAndArguments(const parser::Name &,
       ActualArguments &&, bool isSubroutine = false,
       bool mightBeStructureConstructor = false);
   std::optional<CalleeAndArguments> GetCalleeAndArguments(
       const parser::ProcedureDesignator &, ActualArguments &&,

flang/include/flang/Semantics/tools.h

 bool HasDefinedIo(
     GenericKind::DefinedIo, const DerivedTypeSpec &, const Scope * = nullptr);
 // Seeks out an allocatable or pointer ultimate component that is not
 // nested in a nonallocatable/nonpointer component with a specific
 // defined I/O procedure.
 const Symbol *FindUnsafeIoDirectComponent(
     GenericKind::DefinedIo, const DerivedTypeSpec &, const Scope * = nullptr);
 
+// Some intrinsic operators have more than one name (e.g. `operator(.eq.)` and
+// `operator(==)`). GetAllNames() returns them all, including symbolName.
+std::forward_list<std::string> GetAllNames(
+    const SemanticsContext &, const SourceName &);
+
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_TOOLS_H_

flang/lib/Semantics/expression.cpp

 //===-- lib/Semantics/expression.cpp --------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Semantics/expression.h"
 #include "check-call.h"
 #include "pointer-assignment.h"
+#include "resolve-names-utils.h"
 #include "resolve-names.h"
 #include "flang/Common/Fortran.h"
 #include "flang/Common/idioms.h"
 #include "flang/Evaluate/common.h"
 #include "flang/Evaluate/fold.h"
 #include "flang/Evaluate/tools.h"
 #include "flang/Parser/characters.h"
 #include "flang/Parser/dump-parse-tree.h"
static const Symbol *GetBindingResolution(
   if (!component.attrs().test(semantics::Attr::NON_OVERRIDABLE) &&
       (!baseType || baseType->IsPolymorphic())) {
     return nullptr;
   }
   return &binding->symbol();
 }
 
 auto ExpressionAnalyzer::AnalyzeProcedureComponentRef(
-    const parser::ProcComponentRef &pcr, ActualArguments &&arguments)
-    -> std::optional<CalleeAndArguments> {
+    const parser::ProcComponentRef &pcr, ActualArguments &&arguments,
+    bool isSubroutine) -> std::optional<CalleeAndArguments> {
   const parser::StructureComponent &sc{pcr.v.thing};
   if (MaybeExpr base{Analyze(sc.base)}) {
     if (const Symbol * sym{sc.component.symbol}) {
       if (context_.HasError(sym)) {
         return std::nullopt;
       }
       if (!IsProcedure(*sym)) {
         AttachDeclaration(
             Say(sc.component.source, "'%s' is not a procedure"_err_en_US,
                 sc.component.source),
             *sym);
         return std::nullopt;
       }
       if (auto *dtExpr{UnwrapExpr<Expr<SomeDerived>>(*base)}) {
         if (sym->has<semantics::GenericDetails>()) {
           AdjustActuals adjustment{
               [&](const Symbol &proc, ActualArguments &actuals) {
                 if (!proc.attrs().test(semantics::Attr::NOPASS)) {
                   AddPassArg(actuals, std::move(*dtExpr), proc);
                 }
                 return true;
               }};
-          auto pair{ResolveGeneric(*sym, arguments, adjustment)};
+          auto pair{ResolveGeneric(*sym, arguments, adjustment, isSubroutine)};
           sym = pair.first;
           if (sym) {
             // re-resolve the name to the specific binding
             sc.component.symbol = const_cast<Symbol *>(sym);
           } else {
             EmitGenericResolutionError(*sc.component.symbol, pair.second);
             return std::nullopt;
           }
bool ExpressionAnalyzer::ResolveForward(const Symbol &symbol) {
   }
   return true;
 }
 
 // Resolve a call to a generic procedure with given actual arguments.
 // adjustActuals is called on procedure bindings to handle pass arg.
 std::pair<const Symbol *, bool> ExpressionAnalyzer::ResolveGeneric(
     const Symbol &symbol, const ActualArguments &actuals,
-    const AdjustActuals &adjustActuals, bool mightBeStructureConstructor) {
+    const AdjustActuals &adjustActuals, bool isSubroutine,
+    bool mightBeStructureConstructor) {
   const Symbol *elemental{nullptr}; // matching elemental specific proc
   const Symbol *nonElemental{nullptr}; // matching non-elemental specific
-  const auto &details{symbol.GetUltimate().get<semantics::GenericDetails>()};
+  const Symbol &ultimate{symbol.GetUltimate()};
+  // Check for a match with an explicit INTRINSIC
+  if (ultimate.attrs().test(semantics::Attr::INTRINSIC)) {
+    parser::Messages buffer;
+    auto restorer{foldingContext_.messages().SetMessages(buffer)};
+    ActualArguments localActuals{actuals};
+    if (context_.intrinsics().Probe(
+            CallCharacteristics{ultimate.name().ToString(), isSubroutine},
+            localActuals, foldingContext_) &&
+        !buffer.AnyFatalError()) {
+      return {&ultimate, false};
+    }
+  }
+  if (const auto *details{ultimate.detailsIf<semantics::GenericDetails>()}) {
     bool anyBareNullActual{
         std::find_if(actuals.begin(), actuals.end(), [](auto iter) {
           return IsBareNullPointer(iter->UnwrapExpr());
         }) != actuals.end()};
-  for (const Symbol &specific : details.specificProcs()) {
+    for (const Symbol &specific : details->specificProcs()) {
       if (!ResolveForward(specific)) {
         continue;
       }
       if (std::optional<characteristics::Procedure> procedure{
               characteristics::Procedure::Characterize(
                   ProcedureDesignator{specific}, context_.foldingContext())}) {
         ActualArguments localActuals{actuals};
         if (specific.has<semantics::ProcBindingDetails>()) {
           if (!adjustActuals.value()(specific, localActuals)) {
             continue;
           }
         }
         if (semantics::CheckInterfaceForGeneric(*procedure, localActuals,
                 GetFoldingContext(), false /* no integer conversions */) &&
             CheckCompatibleArguments(*procedure, localActuals)) {
           if ((procedure->IsElemental() && elemental) ||
               (!procedure->IsElemental() && nonElemental)) {
             // 16.9.144(6): a bare NULL() is not allowed as an actual
             // argument to a generic procedure if the specific procedure
             // cannot be unambiguously distinguished
             return {nullptr, true /* due to NULL actuals */};
           }
           if (!procedure->IsElemental()) {
             // takes priority over elemental match
             nonElemental = &specific;
             if (!anyBareNullActual) {
               break; // unambiguous case
             }
           } else {
             elemental = &specific;
           }
         }
       }
     }
     if (nonElemental) {
       return {&AccessSpecific(symbol, *nonElemental), false};
     } else if (elemental) {
       return {&AccessSpecific(symbol, *elemental), false};
     }
     // Check parent derived type
     if (const auto *parentScope{symbol.owner().GetDerivedTypeParent()}) {
       if (const Symbol * extended{parentScope->FindComponent(symbol.name())}) {
-      if (extended->GetUltimate().has<semantics::GenericDetails>()) {
-        auto pair{ResolveGeneric(*extended, actuals, adjustActuals, false)};
+        auto pair{ResolveGeneric(
+            *extended, actuals, adjustActuals, isSubroutine, false)};
         if (pair.first) {
           return pair;
         }
       }
     }
+    if (mightBeStructureConstructor && details->derivedType()) {
+      return {details->derivedType(), false};
+    }
+  }
+  // Check for generic or explicit INTRINSIC of the same name in outer scopes.
+  // See 15.5.5.2 for details.
+  if (!symbol.owner().IsGlobal() && !symbol.owner().IsDerivedType()) {
+    for (const std::string &n : GetAllNames(context_, symbol.name())) {
+      if (const Symbol * outer{symbol.owner().parent().FindSymbol(n)}) {
+        auto pair{ResolveGeneric(*outer, actuals, adjustActuals, isSubroutine,
+            mightBeStructureConstructor)};
+        if (pair.first) {
+          return pair;
+        }
+      }
     }
-  if (mightBeStructureConstructor && details.derivedType()) {
-    return {details.derivedType(), false};
   }
   return {nullptr, false};
 }
 
 const Symbol &ExpressionAnalyzer::AccessSpecific(
     const Symbol &originalGeneric, const Symbol &specific) {
   if (const auto *hosted{
           originalGeneric.detailsIf<semantics::HostAssocDetails>()}) {
auto ExpressionAnalyzer::GetCalleeAndArguments(
     -> std::optional<CalleeAndArguments> {
   return common::visit(
       common::visitors{
           [&](const parser::Name &name) {
             return GetCalleeAndArguments(name, std::move(arguments),
                 isSubroutine, mightBeStructureConstructor);
           },
           [&](const parser::ProcComponentRef &pcr) {
-            return AnalyzeProcedureComponentRef(pcr, std::move(arguments));
+            return AnalyzeProcedureComponentRef(
+                pcr, std::move(arguments), isSubroutine);
           },
       },
       pd.u);
 }
 
 auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
     ActualArguments &&arguments, bool isSubroutine,
     bool mightBeStructureConstructor) -> std::optional<CalleeAndArguments> {
   const Symbol *symbol{name.symbol};
   if (context_.HasError(symbol)) {
     return std::nullopt; // also handles null symbol
   }
   const Symbol &ultimate{DEREF(symbol).GetUltimate()};
   CheckForBadRecursion(name.source, ultimate);
   bool dueToNullActual{false};
   bool isGenericInterface{ultimate.has<semantics::GenericDetails>()};
+  bool isExplicitIntrinsic{ultimate.attrs().test(semantics::Attr::INTRINSIC)};
   const Symbol *resolution{nullptr};
-  if (isGenericInterface) {
+  if (isGenericInterface || isExplicitIntrinsic) {
     ExpressionAnalyzer::AdjustActuals noAdjustment;
-    auto pair{ResolveGeneric(
-        *symbol, arguments, noAdjustment, mightBeStructureConstructor)};
+    auto pair{ResolveGeneric(*symbol, arguments, noAdjustment, isSubroutine,
+        mightBeStructureConstructor)};
     resolution = pair.first;
     dueToNullActual = pair.second;
     if (resolution) {
       // re-resolve name to the specific procedure
       name.symbol = const_cast<Symbol *>(resolution);
     }
+  } else {
+    resolution = symbol;
   }
-  if (!resolution) {
+  if (!resolution || resolution->attrs().test(semantics::Attr::INTRINSIC)) {
     // Not generic, or no resolution; may be intrinsic
-    bool isIntrinsic{symbol->attrs().test(semantics::Attr::INTRINSIC)};
-    if (!isIntrinsic && !isGenericInterface) {
-      resolution = symbol;
-    } else if (std::optional<SpecificCall> specificCall{
-                   context_.intrinsics().Probe(
-                       CallCharacteristics{
-                           ultimate.name().ToString(), isSubroutine},
-                       arguments, GetFoldingContext())}) {
+    if (std::optional<SpecificCall> specificCall{context_.intrinsics().Probe(
+            CallCharacteristics{ultimate.name().ToString(), isSubroutine},
       CheckBadExplicitType(*specificCall, *symbol);
       return CalleeAndArguments{
           ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
           std::move(specificCall->arguments)};
     } else {
       if (isGenericInterface) {
         EmitGenericResolutionError(*symbol, dueToNullActual);
       }

 std::optional<ProcedureRef> ArgumentAnalyzer::GetDefinedAssignmentProc() {
   auto restorer{context_.GetContextualMessages().DiscardMessages()};
   std::string oprNameString{"assignment(=)"};
   parser::CharBlock oprName{oprNameString};
   const Symbol *proc{nullptr};
   const auto &scope{context_.context().FindScope(source_)};
   if (const Symbol * symbol{scope.FindSymbol(oprName)}) {
     ExpressionAnalyzer::AdjustActuals noAdjustment;
-    auto pair{context_.ResolveGeneric(*symbol, actuals_, noAdjustment)};
+    auto pair{context_.ResolveGeneric(*symbol, actuals_, noAdjustment, true)};
     if (pair.first) {
       proc = pair.first;
     } else {
       context_.EmitGenericResolutionError(*symbol, pair.second);
     }
   }
   int passedObjectIndex{-1};
   const Symbol *definedOpSymbol{nullptr};
const Symbol *ArgumentAnalyzer::FindBoundOp(
   if (!symbol) {
     return nullptr;
   }
   definedOp = symbol;
   ExpressionAnalyzer::AdjustActuals adjustment{
       [&](const Symbol &proc, ActualArguments &) {
         return passIndex == GetPassIndex(proc);
       }};
-  auto pair{context_.ResolveGeneric(*symbol, actuals_, adjustment)};
+  auto pair{context_.ResolveGeneric(*symbol, actuals_, adjustment, false)};
   if (!pair.first) {
     context_.EmitGenericResolutionError(*symbol, pair.second);
   }
   return pair.first;
 }
 
 // If there is an implicit conversion between intrinsic types, make it explicit
 void ArgumentAnalyzer::AddAssignmentConversion(

flang/lib/Semantics/resolve-names.cpp

if constexpr (std::is_same_v<DerivedTypeDetails, D>) {
       if (auto *d{symbol->detailsIf<GenericDetails>()}) {
         if (!d->specific()) {
           // derived type with same name as a generic
           auto *derivedType{d->derivedType()};
           if (!derivedType) {
             derivedType =
                 &currScope().MakeSymbol(name, attrs, std::move(details));
             d->set_derivedType(*derivedType);
+          } else if (derivedType->CanReplaceDetails(details)) {
+            // was forward-referenced
+            derivedType->attrs() |= attrs;
+            derivedType->set_details(std::move(details));
           } else {
             SayAlreadyDeclared(name, *derivedType);
           }
           return *derivedType;
         }
       }
     }
     if (symbol->CanReplaceDetails(details)) {
bool DeclarationVisitor::Pre(const parser::IntentStmt &x) {
   auto &intentSpec{std::get<parser::IntentSpec>(x.t)};
   auto &names{std::get<std::list<parser::Name>>(x.t)};
   return CheckNotInBlock("INTENT") && // C1107
       HandleAttributeStmt(IntentSpecToAttr(intentSpec), names);
 }
 bool DeclarationVisitor::Pre(const parser::IntrinsicStmt &x) {
   HandleAttributeStmt(Attr::INTRINSIC, x.v);
   for (const auto &name : x.v) {
+    if (!IsIntrinsic(name.source, std::nullopt)) {
+      Say(name.source, "'%s' is not a known intrinsic procedure"_err_en_US);
+    }
     auto &symbol{DEREF(FindSymbol(name))};
     if (symbol.has<GenericDetails>()) {
       // Generic interface is extending intrinsic; ok
-    } else if (!symbol.has<HostAssocDetails>() &&
-        !ConvertToProcEntity(symbol)) {
+    } else if (!ConvertToProcEntity(symbol)) {
       SayWithDecl(
           name, symbol, "INTRINSIC attribute not allowed on '%s'"_err_en_US);
     } else if (symbol.attrs().test(Attr::EXTERNAL)) { // C840
       Say(symbol.name(),
           "Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US,
           symbol.name());
     } else if (symbol.GetType()) {
       // These warnings are worded so that they should make sense in either
bool DeclarationVisitor::HandleAttributeStmt(
     Attr attr, const std::list<parser::Name> &names) {
   for (const auto &name : names) {
     HandleAttributeStmt(attr, name);
   }
   return false;
 }
 Symbol &DeclarationVisitor::HandleAttributeStmt(
     Attr attr, const parser::Name &name) {
-  if (attr == Attr::INTRINSIC) {
-    if (!IsIntrinsic(name.source, std::nullopt)) {
-      Say(name.source, "'%s' is not a known intrinsic procedure"_err_en_US);
-    } else if (currScope().kind() == Scope::Kind::Subprogram ||
-        currScope().kind() == Scope::Kind::Block) {
-      if (auto *symbol{FindSymbol(name)}) {
-        if (symbol->GetUltimate().has<GenericDetails>() &&
-            symbol->owner() != currScope()) {
-          // Declaring a name INTRINSIC when there is a generic
-          // interface of the same name in the host scope.
-          // Host-associate the generic and mark it INTRINSIC
-          // rather than completely overriding the generic.
-          symbol = &MakeHostAssocSymbol(name, *symbol);
-          symbol->attrs().set(Attr::INTRINSIC);
-          return *symbol;
-        }
-      }
-    }
-  }
   auto *symbol{FindInScope(name)};
   if (attr == Attr::ASYNCHRONOUS || attr == Attr::VOLATILE) {
     // these can be set on a symbol that is host-assoc or use-assoc
     if (!symbol &&
         (currScope().kind() == Scope::Kind::Subprogram ||
             currScope().kind() == Scope::Kind::Block)) {
       if (auto *hostSymbol{FindSymbol(name)}) {
         symbol = &MakeHostAssocSymbol(name, *hostSymbol);
if (!prevType) {
     context().SetError(symbol);
   } else {
     symbol.set(Symbol::Flag::Implicit, false);
   }
 }
 
 std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveDerivedType(
     const parser::Name &name) {
-  Symbol *symbol{FindSymbol(NonDerivedTypeScope(), name)};
-  if (!symbol || symbol->has<UnknownDetails>()) {
+  Scope &outer{NonDerivedTypeScope()};
+  Symbol *symbol{FindSymbol(outer, name)};
+  Symbol *ultimate{symbol ? &symbol->GetUltimate() : nullptr};
+  auto *generic{ultimate ? ultimate->detailsIf<GenericDetails>() : nullptr};
+  if (generic) {
+    if (Symbol * genDT{generic->derivedType()}) {
+      symbol = genDT;
+      generic = nullptr;
+    }
+  }
+  if (!symbol || symbol->has<UnknownDetails>() ||
+      (generic && &ultimate->owner() == &outer)) {
     if (allowForwardReferenceToDerivedType()) {
       if (!symbol) {
-        symbol = &MakeSymbol(InclusiveScope(), name.source, Attrs{});
+        symbol = &MakeSymbol(outer, name.source, Attrs{});
         Resolve(name, *symbol);
-      };
+      } else if (generic) {
+        // forward ref to type with later homonymous generic
+        symbol = &outer.MakeSymbol(name.source, Attrs{}, UnknownDetails{});
+        generic->set_derivedType(*symbol);
+        name.symbol = symbol;
+      }
       DerivedTypeDetails details;
       details.set_isForwardReferenced(true);
       symbol->set_details(std::move(details));
     } else { // C732
       Say(name, "Derived type '%s' not found"_err_en_US);
       return std::nullopt;
     }
   }
   if (CheckUseError(name)) {
     return std::nullopt;
   }
   symbol = &symbol->GetUltimate();
-  if (auto *details{symbol->detailsIf<GenericDetails>()}) {
-    if (details->derivedType()) {
-      symbol = &details->derivedType()->GetUltimate();
-    }
-  }
   if (symbol->has<DerivedTypeDetails>()) {
     return DerivedTypeSpec{name.source, *symbol};
   } else {
     Say(name, "'%s' is not a derived type"_err_en_US);
     return std::nullopt;
   }
 }
 
if (IsLogicalConstant(context(), symbolName)) {
     Say(symbolName,
         "Logical constant '%s' may not be used as a defined operator"_err_en_US);
     return;
   }
   GenericDetails genericDetails;
   Symbol *existing{nullptr};
   // Check all variants of names, e.g. "operator(.ne.)" for "operator(/=)"
   for (const std::string &n : GetAllNames(context(), symbolName)) {
-    existing = currScope().FindSymbol(n);
-    if (existing) {
+    if (auto iter{currScope().find(n)}; iter != currScope().end()) {
+      existing = &*iter->second;
       break;
     }
   }
   if (existing) {
     Symbol &ultimate{existing->GetUltimate()};
     if (const auto *existingGeneric{ultimate.detailsIf<GenericDetails>()}) {
-      if (&ultimate.owner() != &currScope()) {
-        // Create a local copy of a host or use associated generic so that
+      if (const auto *existingUse{existing->detailsIf<UseDetails>()}) {
+        // Create a local copy of a use associated generic so that
         // it can be locally extended without corrupting the original.
         genericDetails.CopyFrom(*existingGeneric);
-        if (const auto *use{existing->detailsIf<UseDetails>()}) {
-          AddGenericUse(genericDetails, existing->name(), use->symbol());
-          EraseSymbol(*existing);
-        }
-        existing = &MakeSymbol(symbolName, Attrs{}, std::move(genericDetails));
-      }
+        AddGenericUse(genericDetails, existing->name(), existingUse->symbol());
+      } else if (existing == &ultimate) {
+        // Extending an extant generic in the same scope
         info.Resolve(existing);
         return;
+      } else {
+        // Host association of a generic is handled in ResolveGeneric()
+        CHECK(existing->has<HostAssocDetails>());
       }
-    if (&existing->owner() == &currScope()) {
-      if (ultimate.has<SubprogramDetails>() ||
-          ultimate.has<SubprogramNameDetails>()) {
-        genericDetails.set_specific(ultimate);
-      } else if (ultimate.has<DerivedTypeDetails>()) {
-        genericDetails.set_derivedType(ultimate);
-      } else {
-        SayAlreadyDeclared(symbolName, *existing);
-        return;
-      }
-      EraseSymbol(*existing);
-    }
-  }
+    } else if (ultimate.has<SubprogramDetails>() ||
   info.Resolve(&MakeSymbol(symbolName, Attrs{}, std::move(genericDetails)));
 }
 
 void ResolveNamesVisitor::FinishSpecificationPart(
     const std::list<parser::DeclarationConstruct> &decls) {
   badStmtFuncFound_ = false;
   funcResultStack().CompleteFunctionResultType();
   CheckImports();

flang/lib/Semantics/tools.cpp

bool IsFinalizable(const DerivedTypeSpec &derived,
   return result;
 }
 
 bool HasImpureFinal(const DerivedTypeSpec &derived) {
   if (const auto *details{
           derived.typeSymbol().detailsIf<DerivedTypeDetails>()}) {
     const auto &finals{details->finals()};
     return std::any_of(finals.begin(), finals.end(),
-        [](const auto &x) { return !x.second->attrs().test(Attr::PURE); });
+        [](const auto &x) { return !IsPureProcedure(*x.second); });
   } else {
     return false;
   }
 }
 
 bool IsAssumedLengthCharacter(const Symbol &symbol) {
   if (const DeclTypeSpec * type{symbol.GetType()}) {
     return type->category() == DeclTypeSpec::Character &&

flang/test/Semantics/generic01.f90

+! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+! Tests rules of 15.5.5.2 for generics and explicit intrinsics
+! competing at various scoping levels.
+module m1
+  private
+  public abs
+  interface abs
+    module procedure :: abs_int_redef, abs_noargs
+  end interface
+contains
+  integer function abs_int_redef(j)
+    integer, intent(in) :: j
+    abs_int_redef = j
+  end function
+  integer function abs_noargs()
+    abs_noargs = 0
+  end function
+end module
+
+module m2
+  private
+  public abs
+  interface abs
+    module procedure abs_real_redef
+  end interface
+contains
+  real function abs_real_redef(x)
+    real, intent(in) :: x
+    abs_real_redef = x
+  end function
+end module
+
+module m3
+  use m1, only: abs
+  implicit none
+contains
+  subroutine test1
+    use m2, only: abs
+    !CHECK: abs_int_redef(
+    print *, abs(1)
+    !CHECK: abs_real_redef(
+    print *, abs(1.)
+    !CHECK: 1.41421353816986083984375_4
+    print *, abs((1,1))
+    !CHECK: abs_noargs(
+    print *, abs()
+  end subroutine
+  subroutine test2
+    intrinsic abs ! override some of module's use of m1
+    block
+      use m2, only: abs
+      !CHECK: 1_4
+      print *, abs(1)
+      !CHECK: abs_real_redef(
+      print *, abs(1.)
+      !CHECK: 1.41421353816986083984375_4
+      print *, abs((1,1))
+      !CHECK: abs_noargs(
+      print *, abs()
+    end block
+  end subroutine
+  subroutine test3
+    interface abs
+      module procedure abs_int_redef2 ! override module's use of m1
+    end interface
+    !CHECK: abs_int_redef2(
+    print *, abs(1)
+    !CHECK: 1._4
+    print *, abs(1.)
+    !CHECK: 1.41421353816986083984375_4
+    print *, abs((1,1))
+    !CHECK: abs_noargs(
+    print *, abs()
+    block
+      use m1, only: abs ! override the override
+      !CHECK: abs_int_redef(
+      print *, abs(1)
+    end block
+  end subroutine
+  integer function abs_int_redef2(j)
+    integer, intent(in) :: j
+    abs_int_redef2 = j
+  end function
+end module

flang/test/Semantics/resolve22.f90

subroutine s3
   interface t
   end interface
   !ERROR: 't' is already declared in this scoping unit
   type t
   end type
   type(t) :: x
   x = t()
 end subroutine
+
+module m4
+  type t1
+    class(t2), pointer :: p => null()
+  end type
+  type t2
+  end type
+  interface t2
+    procedure ctor
+  end interface
+ contains
+  function ctor()
+    type(t2) ctor
+  end function
+end module