[flang] Accept POINTER followed by INTERFACE

[klausler]

Summary

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.

[jeanPerier]

Looks good

flang/include/flang/Semantics/symbol.h

const std::string *bindName() const {
     return bindName_ ? &*bindName_ : nullptr;
   }
   void set_bindName(std::string &&name) { bindName_ = std::move(name); }
 
 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; }
   bool isInterface() const { return isInterface_; }
   void set_isInterface(bool value = true) { isInterface_ = value; }
   bool isDummy() const { return isDummy_; }
   void set_isDummy(bool value = true) { isDummy_ = value; }
   Scope *entryScope() { return entryScope_; }

 public:
   std::optional<SourceName> passName() const { return passName_; }
   void set_passName(const SourceName &passName) { passName_ = passName; }
 
 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;
   explicit ProcEntityDetails(EntityDetails &&d);
 
   const ProcInterface &interface() const { return interface_; }
   ProcInterface &interface() { return interface_; }
   void set_interface(const ProcInterface &interface) { interface_ = interface; }

flang/include/flang/Semantics/tools.h

inline bool IsStmtFunction(const Symbol &symbol) {
   return subprogram && subprogram->stmtFunction();
 }
 bool IsInStmtFunction(const Symbol &);
 bool IsStmtFunctionDummy(const Symbol &);
 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 &);
 bool CanBeTypeBoundProc(const Symbol *);
 // Does a non-PARAMETER symbol have explicit initialization with =value or
 // =>target in its declaration (but not in a DATA statement)? (Being
 // ALLOCATABLE or having a derived type with default component initialization
 // doesn't count; it must be a variable initialization that implies the SAVE

flang/lib/Evaluate/tools.cpp

 const Symbol *FindCommonBlockContaining(const Symbol &original) {
   const Symbol &root{GetAssociationRoot(original)};
   const auto *details{root.detailsIf<ObjectEntityDetails>()};
   return details ? details->commonBlock() : nullptr;
 }
 
 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
 bool IsAutomatic(const Symbol &original) {
   const Symbol &symbol{original.GetUltimate()};
   if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
     if (!object->isDummy() && !IsAllocatable(symbol) && !IsPointer(symbol)) {
       if (const DeclTypeSpec * type{symbol.GetType()}) {

flang/lib/Lower/ConvertType.cpp

mlir::Type genDerivedType(const Fortran::semantics::DerivedTypeSpec &tySpec) {
     // (1) The data components.
     for (const auto &field :
          Fortran::semantics::OrderedComponentIterator(tySpec)) {
       // Lowering is assuming non deferred component lower bounds are always 1.
       // Catch any situations where this is not true for now.
       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
       // added and should be sufficient, the parent component would
       // duplicate the fields).
       if (field.test(Fortran::semantics::Symbol::Flag::ParentComp))
         continue;
       cs.emplace_back(field.name().ToString(), ty);

flang/lib/Semantics/check-nullify.cpp

parser::ContextualMessages messages{
       *context_.location(), &context_.messages()};
   for (const parser::PointerObject &pointerObject : nullifyStmt.v) {
     common::visit(
         common::visitors{
             [&](const parser::Name &name) {
               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);
               } else if (pure) {
                 CheckDefinabilityInPureScope(messages, *symbol, scope, *pure);
               }
             },
             [&](const parser::StructureComponent &structureComponent) {

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

if (static_cast<std::size_t>(offsetSymbol.offset() + offsetSymbol.size()) >
         symbol.size()) {
       OutOfRangeError();
     } else if (evaluate::IsNullPointer(*expr)) {
       // nothing to do; rely on zero initialization
       return true;
     } else if (isProcPointer) {
       if (evaluate::IsProcedure(*expr)) {
         if (CheckPointerAssignment(context, designator, *expr)) {
+          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(
             "Data object '%s' may not be used to initialize '%s', which is a procedure pointer"_err_en_US,
             expr->AsFortran(), DescribeElement());
       }
     } else if (evaluate::IsProcedure(*expr)) {
       exprAnalyzer_.Say(

flang/lib/Semantics/resolve-names.cpp

if (auto *generic{symbol.detailsIf<GenericDetails>()}) {
     return symbol.has<UnknownDetails>() || symbol.has<SubprogramNameDetails>();
   }
 }
 
 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.
     } else if (!HandlePreviousCalls(name, *prev, subpFlag)) {
       SayAlreadyDeclared(name, *prev);
     }
   }
 }
if (bindingSpec && currScope().IsGlobal() && bindingSpec->v) {
               MiscDetails{MiscDetails::Kind::ScopeName}));
     }
     CheckExtantProc(name, subpFlag);
     symbol = &MakeSymbol(name, SubprogramDetails{});
   }
   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);
     } else {
       MakeExternal(*symbol);
     }
     if (isGeneric()) {
       Symbol &genericSymbol{GetGenericSymbol()};

flang/lib/Semantics/tools.cpp

 bool IsStmtFunctionResult(const Symbol &symbol) {
   return IsFunctionResult(symbol) && IsInStmtFunction(symbol);
 }
 
 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()}) {
       // procedure component with a BIND(C) interface
       return IsBindCProcedure(*procInterface);
     }
   }
   return symbol.attrs().test(Attr::BIND_C) && IsProcedure(symbol);

flang/test/Semantics/nullify02.f90

 
 Allocate(x(3))
 !ERROR: component in NULLIFY statement must have the POINTER attribute
 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
 
 ! Make sure that the compiler doesn't crash when NULLIFY is used in a context
 ! that has reported errors
 module badNullify
   interface

flang/test/Semantics/procinterface01.f90

 ! RUN: %python %S/test_symbols.py %s %flang_fc1
 ! Tests for "proc-interface" semantics.
 ! These cases are all valid.
 
 !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)
   real function abstract1(x)
    !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)
   !DEF: /module1/explicit1/x INTENT(IN) ObjectEntity REAL(4)
   real function explicit1(x)
    !REF: /module1/explicit1/x
    real, intent(in) :: x
   end function explicit1