[flang] Catch bad usage of POINTER attribute

[klausler]

Summary

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.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/docs/Extensions.md

 * When a type-bound procedure declaration statement has neither interface
   nor attributes, the "::" before the bindings is optional, even
   if a binding has renaming with "=> proc".
   The colons are not necessary for an unambiguous parse, C768
   notwithstanding.
 * 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
 
 * C-style backslash escape sequences in quoted CHARACTER literals
   (but not Hollerith) [-fbackslash]
 * Logical abbreviations `.T.`, `.F.`, `.N.`, `.A.`, `.O.`, and `.X.`
   [-flogical-abbreviations]
 * `.XOR.` as a synonym for `.NEQV.` [-fxor-operator]

flang/lib/Semantics/resolve-names.cpp

bool SubprogramVisitor::HandlePreviousCalls(
   }
 }
 
 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()) {
+               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
       // in scopes between the global scope and the current scope.
     } else if (!HandlePreviousCalls(name, *prev, subpFlag)) {
       SayAlreadyDeclared(name, *prev);
     }
   }
if (const auto &deferredShapeSpecs{
           std::get<std::optional<parser::DeferredShapeSpecList>>(x.t)}) {
     CHECK(arraySpec().empty());
     BeginArraySpec();
     set_arraySpec(AnalyzeDeferredShapeSpecList(context(), *deferredShapeSpecs));
     Symbol &symbol{DeclareObjectEntity(name, Attrs{Attr::POINTER})};
     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));
   }
 }
 
 bool DeclarationVisitor::Pre(const parser::BindEntity &x) {
   auto kind{std::get<parser::BindEntity::Kind>(x.t)};
   auto &name{std::get<parser::Name>(x.t)};
   Symbol *symbol;

flang/test/Semantics/pointer01.f90

+! 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