From 0d242e2006f9a754a594274f6f15cd364924c000 Mon Sep 17 00:00:00 2001
From: peter klausler <pklausler@nvidia.com>
Date: Tue, 4 Jun 2019 11:41:30 -0700
Subject: [PATCH] [flang] INTRINSIC attribute should convert symbol to
 procedure; also check C840

Original-commit: flang-compiler/f18@b698b84ccd1cab75c376f2df1519917403147957
Reviewed-on: https://github.com/flang-compiler/f18/pull/477
Tree-same-pre-rewrite: false
---
 flang/lib/semantics/resolve-names.cc | 31 ++++++++++++++++++++++++++++---
 1 file changed, 28 insertions(+), 3 deletions(-)

diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc
index 5f467f2..bc5aee9 100644
--- a/flang/lib/semantics/resolve-names.cc
+++ b/flang/lib/semantics/resolve-names.cc
@@ -512,6 +512,8 @@ public:
     }
   }
 
+  void MakeExternal(Symbol &);
+
 protected:
   // Apply the implicit type rules to this symbol.
   void ApplyImplicitRules(Symbol &);
@@ -1743,6 +1745,17 @@ const DeclTypeSpec &ScopeHandler::MakeLogicalType(
   }
 }
 
+void ScopeHandler::MakeExternal(Symbol &symbol) {
+  if (!symbol.attrs().test(Attr::EXTERNAL)) {
+    symbol.attrs().set(Attr::EXTERNAL);
+    if (symbol.attrs().test(Attr::INTRINSIC)) {  // C840
+      Say(symbol.name(),
+          "Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US,
+          symbol.name());
+    }
+  }
+}
+
 // ModuleVisitor implementation
 
 bool ModuleVisitor::Pre(const parser::Only &x) {
@@ -2352,7 +2365,7 @@ Symbol &SubprogramVisitor::PushSubprogramScope(
   if (inInterfaceBlock()) {
     details.set_isInterface();
     if (!isAbstract()) {
-      symbol->attrs().set(Attr::EXTERNAL);
+      MakeExternal(*symbol);
     }
     if (isGeneric()) {
       GetGenericDetails().add_specificProc(*symbol);
@@ -2552,7 +2565,19 @@ bool DeclarationVisitor::Pre(const parser::IntentStmt &x) {
       HandleAttributeStmt(IntentSpecToAttr(intentSpec), names);
 }
 bool DeclarationVisitor::Pre(const parser::IntrinsicStmt &x) {
-  return HandleAttributeStmt(Attr::INTRINSIC, x.v);
+  HandleAttributeStmt(Attr::INTRINSIC, x.v);
+  for (const auto &name : x.v) {
+    auto *symbol{FindSymbol(name)};
+    if (!ConvertToProcEntity(*symbol)) {
+      SayWithDecl(
+          name, *symbol, "INTRINSIC attribute not allowed on '%s'"_err_en_US);
+    } else if (symbol->attrs().test(Attr::EXTERNAL)) {  // C840
+      Say(symbol->name(),
+          "Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US,
+          symbol->name());
+    }
+  }
+  return false;
 }
 bool DeclarationVisitor::Pre(const parser::OptionalStmt &x) {
   return CheckNotInBlock("OPTIONAL") &&
@@ -4383,7 +4408,7 @@ void ResolveNamesVisitor::HandleProcedureName(
           " attribute in a scope with IMPLICIT NONE(EXTERNAL)"_err_en_US);
       return;
     }
-    symbol->attrs().set(Attr::EXTERNAL);
+    MakeExternal(*symbol);
     if (!symbol->has<ProcEntityDetails>()) {
       ConvertToProcEntity(*symbol);
     }
-- 
2.7.4