[flang] Accept a separate module procedure interface as a specific procedure

[klausler]

Summary

The code snippet

module m
  interface
    module subroutine specific
    end subroutine
  end interface
  interface generic
     module procedure specific
  end interface
end module

elicits a bogus semantic error about "specific" not being an acceptable
module procedure for the generic interface; fix.

[PeteSteinfeld]

All builds and tests correctly and fixes the specified problem. But we should have a test for the new error message.

flang/lib/Semantics/check-declarations.cpp

1201

It would be good to have a test that produces this message.

[klausler]

Add test for error message.

[PeteSteinfeld]

Thanks, Peter. All builds and tests correctly and looks good.

flang/lib/Semantics/check-call.cpp

parser::Messages CheckExplicitInterface(const characteristics::Procedure &proc,
     const Scope &scope, const evaluate::SpecificIntrinsic *intrinsic) {
   return CheckExplicitInterface(
       proc, actuals, context, &scope, intrinsic, true);
 }
 
 bool CheckInterfaceForGeneric(const characteristics::Procedure &proc,
     evaluate::ActualArguments &actuals, const evaluate::FoldingContext &context,
     bool allowActualArgumentConversions) {
-  return !CheckExplicitInterface(
-      proc, actuals, context, nullptr, nullptr, allowActualArgumentConversions)
-              .AnyFatalError();
+  return proc.HasExplicitInterface() &&
+      !CheckExplicitInterface(proc, actuals, context, nullptr, nullptr,
+          allowActualArgumentConversions)
 }
 
 void CheckArguments(const characteristics::Procedure &proc,
     evaluate::ActualArguments &actuals, evaluate::FoldingContext &context,
     const Scope &scope, bool treatingExternalAsImplicit,
     const evaluate::SpecificIntrinsic *intrinsic) {
   bool explicitInterface{proc.HasExplicitInterface()};
   parser::ContextualMessages &messages{context.messages()};

flang/lib/Semantics/check-declarations.cpp

common::visit(common::visitors{
                 },
       details.kind().u);
 }
 
 // Check that the specifics of this generic are distinguishable from each other
 void CheckHelper::CheckSpecificsAreDistinguishable(
     const Symbol &generic, const GenericDetails &details) {
   GenericKind kind{details.kind()};
-  const SymbolVector &specifics{details.specificProcs()};
-  std::size_t count{specifics.size()};
-  if (count < 2 || !kind.IsName()) {
+  if (!kind.IsName()) {
     return;
   }
   DistinguishabilityHelper helper{context_};
-  for (const Symbol &specific : specifics) {
+  for (const Symbol &specific : details.specificProcs()) {
     if (const Procedure * procedure{Characterize(specific)}) {
+      if (procedure->HasExplicitInterface()) {
         helper.Add(generic, kind, specific, *procedure);
+      } else {
+        if (auto *msg{messages_.Say(specific.name(),
+                "Specific procedure '%s' of generic interface '%s' must have an explicit interface"_err_en_US,
+                specific.name(), generic.name())}) {
+          msg->Attach(
+              generic.name(), "Definition of '%s'"_en_US, generic.name());
+        }
+      }
     }
   }
   helper.Check(generic.owner());
 }
 
 static bool ConflictsWithIntrinsicAssignment(const Procedure &proc) {
   auto lhs{std::get<DummyDataObject>(proc.dummyArguments[0].u).type};
   auto rhs{std::get<DummyDataObject>(proc.dummyArguments[1].u).type};

flang/lib/Semantics/resolve-names.cpp

for (auto it{range.first}; it != range.second; ++it) {
     // procedure that is recorded in the GenericDetails below must be *symbol,
     // not the specific procedure shadowed by a generic, because that specific
     // procedure may be a symbol from another module and its name unavailable to
     // emit to a module file.
     const Symbol &bypassed{BypassGeneric(*symbol)};
     const Symbol &specific{
         symbol == &symbol->GetUltimate() ? bypassed : *symbol};
     const Symbol &ultimate{bypassed.GetUltimate()};
-    if (!ultimate.has<SubprogramDetails>() &&
-        !ultimate.has<SubprogramNameDetails>()) {
-      Say(*name, "'%s' is not a subprogram"_err_en_US);
-      continue;
-    }
-    if (kind == ProcedureKind::ModuleProcedure) {
-      if (const auto *nd{ultimate.detailsIf<SubprogramNameDetails>()}) {
-        if (nd->kind() != SubprogramKind::Module) {
-          Say(*name, "'%s' is not a module procedure"_err_en_US);
-        }
-      } else {
-        // USE-associated procedure
-        const auto *sd{ultimate.detailsIf<SubprogramDetails>()};
-        CHECK(sd);
-        if (ultimate.owner().kind() != Scope::Kind::Module ||
-            sd->isInterface()) {
-          Say(*name, "'%s' is not a module procedure"_err_en_US);
-        }
+    ProcedureDefinitionClass defClass{ClassifyProcedure(ultimate)};
+    if (defClass == ProcedureDefinitionClass::Module) {
+      // ok
+    } else if (kind == ProcedureKind::ModuleProcedure) {
+      continue;
+      switch (defClass) {
+      case ProcedureDefinitionClass::Intrinsic:
+      case ProcedureDefinitionClass::External:
+      case ProcedureDefinitionClass::Internal:
+        break;
+      case ProcedureDefinitionClass::None:
+        Say(*name, "'%s' is not a procedure"_err_en_US);
+        continue;
+      default:
+        Say(*name,
+            "'%s' is not a procedure that can appear in a generic interface"_err_en_US);
+        continue;
       }
     }
     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) {

flang/lib/Semantics/tools.cpp

ProcedureDefinitionClass ClassifyProcedure(const Symbol &symbol) { // 15.2.2
   } else if (ultimate.attrs().test(Attr::EXTERNAL)) {
     return ProcedureDefinitionClass::External;
   } else if (const auto *procDetails{ultimate.detailsIf<ProcEntityDetails>()}) {
     if (procDetails->isDummy()) {
       return ProcedureDefinitionClass::Dummy;
     } else if (IsPointer(ultimate)) {
       return ProcedureDefinitionClass::Pointer;
     }
+  } else if (const auto *nameDetails{
+                 ultimate.detailsIf<SubprogramNameDetails>()}) {
+    switch (nameDetails->kind()) {
+    case SubprogramKind::Module:
+      return ProcedureDefinitionClass::Module;
+    case SubprogramKind::Internal:
+      return ProcedureDefinitionClass::Internal;
+    }
   } else if (const Symbol * subp{FindSubprogram(symbol)}) {
     if (const auto *subpDetails{subp->detailsIf<SubprogramDetails>()}) {
       if (subpDetails->stmtFunction()) {
         return ProcedureDefinitionClass::StatementFunction;
       }
     }
     switch (ultimate.owner().kind()) {
     case Scope::Kind::Global:

flang/test/Semantics/generic02.f90

+! RUN: %python %S/test_errors.py %s %flang_fc1
+program test
+  interface generic
+    subroutine explicit(n)
+      integer, intent(in) :: n
+    end subroutine
+    procedure implicit
+  end interface
+!ERROR: Specific procedure 'implicit' of generic interface 'generic' must have an explicit interface
+  external implicit
+  call generic(1)
+end

flang/test/Semantics/resolve15.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 module m
   real :: var
   interface i
-    !ERROR: 'var' is not a subprogram
+    !ERROR: 'var' is not a procedure
     procedure :: sub, var
     !ERROR: Procedure 'bad' not found
     procedure :: bad
   end interface
   interface operator(.foo.)
-    !ERROR: 'var' is not a subprogram
+    !ERROR: 'var' is not a procedure
     procedure :: var
     !ERROR: OPERATOR(.foo.) procedure 'sub' must be a function
     procedure :: sub
     !ERROR: Procedure 'bad' not found
     procedure :: bad
   end interface
 contains
   subroutine sub
interface assignment(=)
     module procedure :: sub
   end interface
 contains
   subroutine sub(x, y)
     real, intent(out) :: x
     logical, intent(in) :: y
   end
 end
+
+module m2
+  interface
+    module subroutine specific
+    end subroutine
+  end interface
+  interface generic
+     module procedure specific
+  end interface
+end module