[flang] Accept POINTER followed by INTERFACE

As is already supported for dummy procedures, we need to also accept
declarations of procedure pointers that consist of a POINTER attribute
statement followed by an INTERFACE block.  (The case of an INTERFACE
block followed by a POINTER statement already works.)

While cleaning this case up, adjust the utility predicate IsProcedurePointer()
to recognize it (namely a SubprogramDetails symbol with Attr::POINTER)
and delete IsProcName().  Extend tests, and add better comments to
symbol.h to document the two ways in which procedure pointers are
represented.

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

flang/include/flang/Semantics/symbol.h

@@ -76,6 +76,9 @@ private:
   std::optional<std::string> bindName_;
 };
 
+// A subroutine or function definition, or a subprogram interface defined
+// in an INTERFACE block as part of the definition of a dummy procedure
+// or a procedure pointer (with just POINTER).
 class SubprogramDetails : public WithBindName {
 public:
   bool isFunction() const { return result_ != nullptr; }
@@ -244,7 +247,9 @@ private:
   std::optional<SourceName> passName_;
 };
 
-// A procedure pointer, dummy procedure, or external procedure
+// A procedure pointer (other than one defined with POINTER and an
+// INTERFACE block), a dummy procedure (without an INTERFACE but with
+// EXTERNAL or use in a procedure reference), or external procedure.
 class ProcEntityDetails : public EntityDetails, public WithPassArg {
 public:
   ProcEntityDetails() = default;

flang/include/flang/Semantics/tools.h

@@ -96,7 +96,6 @@ bool IsStmtFunctionResult(const Symbol &);
 bool IsPointerDummy(const Symbol &);
 bool IsBindCProcedure(const Symbol &);
 bool IsBindCProcedure(const Scope &);
-bool IsProcName(const Symbol &); // proc-name
 // Returns a pointer to the function's symbol when true, else null
 const Symbol *IsFunctionResultWithSameNameAsFunction(const Symbol &);
 bool IsOrContainsEventOrLockComponent(const Symbol &);

flang/lib/Evaluate/tools.cpp

@@ -1266,7 +1266,8 @@ const Symbol *FindCommonBlockContaining(const Symbol &original) {
 
 bool IsProcedurePointer(const Symbol &original) {
   const Symbol &symbol{GetAssociationRoot(original)};
-  return symbol.has<ProcEntityDetails>() && IsPointer(symbol);
+  return IsPointer(symbol) &&
+      (symbol.has<ProcEntityDetails>() || symbol.has<SubprogramDetails>());
 }
 
 // 3.11 automatic data object

flang/lib/Lower/ConvertType.cpp

@@ -301,7 +301,7 @@ struct TypeBuilder {
       if (componentHasNonDefaultLowerBounds(field))
         TODO(converter.genLocation(field.name()),
              "lowering derived type components with non default lower bounds");
-      if (IsProcName(field))
+      if (IsProcedure(field))
         TODO(converter.genLocation(field.name()), "procedure components");
       mlir::Type ty = genSymbolType(field);
       // Do not add the parent component (component of the parents are

flang/lib/Semantics/check-nullify.cpp

@@ -29,9 +29,10 @@ void NullifyChecker::Leave(const parser::NullifyStmt &nullifyStmt) {
               const Symbol *symbol{name.symbol};
               if (context_.HasError(symbol)) {
                 // already reported an error
-              } else if (!IsVariableName(*symbol) && !IsProcName(*symbol)) {
+              } else if (!IsVariableName(*symbol) &&
+                  !IsProcedurePointer(*symbol)) {
                 messages.Say(name.source,
-                    "name in NULLIFY statement must be a variable or procedure pointer name"_err_en_US);
+                    "name in NULLIFY statement must be a variable or procedure pointer"_err_en_US);
               } else if (!IsPointer(*symbol)) { // C951
                 messages.Say(name.source,
                     "name in NULLIFY statement must have the POINTER attribute"_err_en_US);

flang/lib/Semantics/data-to-inits.cpp

@@ -375,8 +375,16 @@ bool DataInitializationCompiler<DSV>::InitElement(
     } else if (isProcPointer) {
       if (evaluate::IsProcedure(*expr)) {
         if (CheckPointerAssignment(context, designator, *expr)) {
-          GetImage().AddPointer(offsetSymbol.offset(), *expr);
-          return true;
+          if (lastSymbol->has<ProcEntityDetails>()) {
+            GetImage().AddPointer(offsetSymbol.offset(), *expr);
+            return true;
+          } else {
+            evaluate::AttachDeclaration(
+                exprAnalyzer_.context().Say(
+                    "DATA statement initialization of procedure pointer '%s' declared using a POINTER statement and an INTERFACE instead of a PROCEDURE statement"_todo_en_US,
+                    DescribeElement()),
+                *lastSymbol);
+          }
         }
       } else {
         exprAnalyzer_.Say(

flang/lib/Semantics/resolve-names.cpp

@@ -3592,6 +3592,9 @@ void SubprogramVisitor::CheckExtantProc(
     const parser::Name &name, Symbol::Flag subpFlag) {
   if (auto *prev{FindSymbol(name)}) {
     if (IsDummy(*prev)) {
+    } else if (auto *entity{prev->detailsIf<EntityDetails>()};
+               IsPointer(*prev) && !entity->type()) {
+      // POINTER attribute set before interface
     } else if (inInterfaceBlock() && currScope() != prev->owner()) {
       // Procedures in an INTERFACE block do not resolve to symbols
       // in scopes between the global scope and the current scope.
@@ -3619,8 +3622,8 @@ Symbol &SubprogramVisitor::PushSubprogramScope(const parser::Name &name,
   symbol->ReplaceName(name.source);
   symbol->set(subpFlag);
   PushScope(Scope::Kind::Subprogram, symbol);
-  auto &details{symbol->get<SubprogramDetails>()};
   if (inInterfaceBlock()) {
+    auto &details{symbol->get<SubprogramDetails>()};
     details.set_isInterface();
     if (isAbstract()) {
       symbol->attrs().set(Attr::ABSTRACT);

flang/lib/Semantics/tools.cpp

@@ -250,11 +250,6 @@ bool IsPointerDummy(const Symbol &symbol) {
   return IsPointer(symbol) && IsDummy(symbol);
 }
 
-// proc-name
-bool IsProcName(const Symbol &symbol) {
-  return symbol.GetUltimate().has<ProcEntityDetails>();
-}
-
 bool IsBindCProcedure(const Symbol &symbol) {
   if (const auto *procDetails{symbol.detailsIf<ProcEntityDetails>()}) {
     if (const Symbol * procInterface{procDetails->interface().symbol()}) {

flang/test/Semantics/nullify02.f90

@@ -22,10 +22,10 @@ Nullify(x(2)%p)
 !ERROR: name in NULLIFY statement must have the POINTER attribute
 Nullify(pi)
 
-!ERROR: name in NULLIFY statement must have the POINTER attribute
+!ERROR: name in NULLIFY statement must be a variable or procedure pointer
 Nullify(prp)
 
-!ERROR: name in NULLIFY statement must be a variable or procedure pointer name
+!ERROR: name in NULLIFY statement must be a variable or procedure pointer
 Nullify(maxvalue)
 
 End Program

flang/test/Semantics/procinterface01.f90

@@ -4,6 +4,8 @@
 
 !DEF: /module1 Module
 module module1
+ !DEF:/module1/abstract2 ABSTRACT, POINTER, PUBLIC (Subroutine) Subprogram
+ pointer :: abstract2
  abstract interface
   !DEF: /module1/abstract1 ABSTRACT, PUBLIC (Function) Subprogram REAL(4)
   !DEF: /module1/abstract1/x INTENT(IN) ObjectEntity REAL(4)
@@ -11,7 +13,15 @@ module module1
    !REF: /module1/abstract1/x
    real, intent(in) :: x
   end function abstract1
+  !REF:/module1/abstract2
+  subroutine abstract2
+  end subroutine
+  !DEF:/module1/abstract3 ABSTRACT, POINTER, PUBLIC (Subroutine) Subprogram
+  subroutine abstract3
+  end subroutine
  end interface
+ !REF:/module1/abstract3
+ pointer :: abstract3
 
  interface
   !DEF: /module1/explicit1 EXTERNAL, PUBLIC (Function) Subprogram REAL(4)