From e5813a683a81001d3853cb3d2b1397a11e98c1dd Mon Sep 17 00:00:00 2001
From: peter klausler <pklausler@nvidia.com>
Date: Tue, 15 Jun 2021 15:15:34 -0700
Subject: [PATCH] [flang] Fix crashes on calls to non-procedures

When a procedure reference is attempted to an entity that just
isn't a procedure, say so.

Differential Revision: https://reviews.llvm.org/D104329
---
 flang/lib/Semantics/expression.cpp    | 14 ++++++++++-
 flang/lib/Semantics/resolve-names.cpp | 10 ++------
 flang/test/Semantics/call19.f90       | 34 +++++++++++++++++++++++++++
 flang/test/Semantics/resolve09.f90    |  4 ++--
 4 files changed, 51 insertions(+), 11 deletions(-)
 create mode 100644 flang/test/Semantics/call19.f90

diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 2b3f6fb57d63..dd547ab87b88 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -1827,6 +1827,12 @@ auto ExpressionAnalyzer::AnalyzeProcedureComponentRef(
       if (context_.HasError(sym)) {
         return std::nullopt;
       }
+      if (!IsProcedure(*sym)) {
+        AttachDeclaration(
+            Say(sc.component.source, "'%s' is not a procedure"_err_en_US,
+                sc.component.source),
+            *sym);
+      }
       if (auto *dtExpr{UnwrapExpr<Expr<SomeDerived>>(*base)}) {
         if (sym->has<semantics::GenericDetails>()) {
           AdjustActuals adjustment{
@@ -2091,10 +2097,16 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
           return CalleeAndArguments{
               semantics::SymbolRef{*symbol}, std::move(arguments)};
         }
-      } else {
+      } else if (IsProcedure(*symbol)) {
         return CalleeAndArguments{
             ProcedureDesignator{*symbol}, std::move(arguments)};
       }
+      if (!context_.HasError(*symbol)) {
+        AttachDeclaration(
+            Say(name.source, "'%s' is not a callable procedure"_err_en_US,
+                name.source),
+            *symbol);
+      }
     } else if (std::optional<SpecificCall> specificCall{
                    context_.intrinsics().Probe(
                        CallCharacteristics{
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 110114597d1f..efba039fe9b3 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -6164,16 +6164,10 @@ void ResolveNamesVisitor::HandleProcedureName(
       symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{});
     }
     Resolve(name, *symbol);
-    if (symbol->has<ModuleDetails>()) {
-      SayWithDecl(name, *symbol,
-          "Use of '%s' as a procedure conflicts with its declaration"_err_en_US);
-      return;
-    }
     if (!symbol->attrs().test(Attr::INTRINSIC)) {
-      if (!CheckImplicitNoneExternal(name.source, *symbol)) {
-        return;
+      if (CheckImplicitNoneExternal(name.source, *symbol)) {
+        MakeExternal(*symbol);
       }
-      MakeExternal(*symbol);
     }
     ConvertToProcEntity(*symbol);
     SetProcFlag(name, *symbol, flag);
diff --git a/flang/test/Semantics/call19.f90 b/flang/test/Semantics/call19.f90
new file mode 100644
index 000000000000..20edb167581f
--- /dev/null
+++ b/flang/test/Semantics/call19.f90
@@ -0,0 +1,34 @@
+! RUN: %S/test_errors.sh %s %t %flang_fc1
+! Ensures that things that aren't procedures aren't allowed to be called.
+module m
+  integer :: i
+  integer, pointer :: ip
+  type :: t
+  end type
+  type :: pdt(k,len)
+    integer, kind :: k
+    integer, len :: len
+  end type
+  type(pdt(1,2)) :: x
+  namelist /nml/i
+ contains
+  subroutine s(d)
+    real d
+    !ERROR: 'm' is not a callable procedure
+    call m
+    !ERROR: Cannot call function 'i' like a subroutine
+    call i
+    !ERROR: Cannot call function 'ip' like a subroutine
+    call ip
+    !ERROR: 't' is not a callable procedure
+    call t
+    !ERROR: 'k' is not a procedure
+    call x%k
+    !ERROR: 'len' is not a procedure
+    call x%len
+    !ERROR: Use of 'nml' as a procedure conflicts with its declaration
+    call nml
+    !ERROR: Cannot call function 'd' like a subroutine
+    call d
+  end subroutine
+end
diff --git a/flang/test/Semantics/resolve09.f90 b/flang/test/Semantics/resolve09.f90
index e92eaf7fde50..c669b60471d7 100644
--- a/flang/test/Semantics/resolve09.f90
+++ b/flang/test/Semantics/resolve09.f90
@@ -71,9 +71,9 @@ subroutine s4
   block
     import, none
     integer :: i
-    !ERROR: Use of 'm' as a procedure conflicts with its declaration
+    !ERROR: 'm' is not a callable procedure
     i = m()
-    !ERROR: Use of 'm' as a procedure conflicts with its declaration
+    !ERROR: 'm' is not a callable procedure
     call m()
   end block
 end