[flang] Catch bad usage of POINTER attribute

Most attributes apply to only object or only procedure entities,
and attempts to apply them to other kinds of symbol table entries
are caught in name resolution when ConvertToObjectEntity() or
ConvertToProcEntity() fails.  However, the POINTER attribute can
be applied to both, and name resolution can't perform that conversion
yet, and as a result we don't catch many kinds of silly errors.
Fix by ensuring that the symbol is of a type that could eventually
become an object or procedure entity if it is not one already.

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

flang/docs/Extensions.md

@@ -250,6 +250,8 @@ end
 * A type-bound procedure binding can be passed as an actual
   argument corresponding to a dummy procedure and can be used as
   the target of a procedure pointer assignment statement.
+* An explicit `INTERFACE` can declare the interface of a
+  procedure pointer even if it is not a dummy argument.
 
 ### Extensions supported when enabled by options
 

flang/lib/Semantics/resolve-names.cpp

@@ -3856,7 +3856,7 @@ void SubprogramVisitor::CheckExtantProc(
   if (auto *prev{FindSymbol(name)}) {
     if (IsDummy(*prev)) {
     } else if (auto *entity{prev->detailsIf<EntityDetails>()};
-               IsPointer(*prev) && !entity->type()) {
+               IsPointer(*prev) && entity && !entity->type()) {
       // POINTER attribute set before interface
     } else if (inInterfaceBlock() && currScope() != prev->owner()) {
       // Procedures in an INTERFACE block do not resolve to symbols
@@ -4071,6 +4071,17 @@ void DeclarationVisitor::Post(const parser::PointerDecl &x) {
     symbol.ReplaceName(name.source);
     EndArraySpec();
   } else {
+    if (const auto *symbol{FindInScope(name)}) {
+      const auto *subp{symbol->detailsIf<SubprogramDetails>()};
+      if (!symbol->has<UseDetails>() && // error caught elsewhere
+          !symbol->has<ObjectEntityDetails>() &&
+          !symbol->has<ProcEntityDetails>() &&
+          !symbol->CanReplaceDetails(ObjectEntityDetails{}) &&
+          !symbol->CanReplaceDetails(ProcEntityDetails{}) &&
+          !(subp && subp->isInterface())) {
+        Say(name, "'%s' cannot have the POINTER attribute"_err_en_US);
+      }
+    }
     HandleAttributeStmt(Attr::POINTER, std::get<parser::Name>(x.t));
   }
 }

flang/test/Semantics/pointer01.f90

@@ -0,0 +1,37 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+module m
+  real mobj
+ contains
+  subroutine msubr
+  end subroutine
+end module
+program main
+  use m
+  !PORTABILITY: Name 'main' declared in a main program should not have the same name as the main program
+  pointer main
+  !ERROR: Cannot change POINTER attribute on use-associated 'mobj'
+  pointer mobj
+  !ERROR: Cannot change POINTER attribute on use-associated 'msubr'
+  pointer msubr
+  !ERROR: 'inner' cannot have the POINTER attribute
+  pointer inner
+  real obj
+  !ERROR: 'ip' may not have both the POINTER and PARAMETER attributes
+  integer, parameter :: ip = 123
+  pointer ip
+  type dt; end type
+  !ERROR: 'dt' cannot have the POINTER attribute
+  pointer dt
+  interface generic
+    subroutine extsub
+    end subroutine
+  end interface
+  !ERROR: 'generic' cannot have the POINTER attribute
+  pointer generic
+  namelist /nml/ obj
+  !ERROR: 'nml' cannot have the POINTER attribute
+  pointer nml
+ contains
+  subroutine inner
+  end subroutine
+end