From 5e8094bae50b1dd533ca0a20693d28a58b9c0d59 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler@nvidia.com>
Date: Wed, 27 Jul 2022 13:15:24 -0700
Subject: [PATCH] [flang] Don't inherit ELEMENTAL attribute from intrinsics for
 TBP bindings

Type-bound procedure bindings that specify intrinsic procedures as their
interfaces should not acquire the ELEMENTAL attribute from the purposes
of compatibility checking between inherited bindings and their overrides
in extended derived types.

Differential Revision: https://reviews.llvm.org/D131104
---
 flang/lib/Evaluate/characteristics.cpp     | 6 ++++--
 flang/lib/Evaluate/tools.cpp               | 3 ++-
 flang/lib/Semantics/check-declarations.cpp | 4 ++--
 3 files changed, 8 insertions(+), 5 deletions(-)

diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 89d794f..cc092cd 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -530,15 +530,17 @@ static std::optional<Procedure> CharacterizeProcedure(
           [&](const semantics::ProcBindingDetails &binding) {
             if (auto result{CharacterizeProcedure(
                     binding.symbol(), context, seenProcs)}) {
+              if (binding.symbol().attrs().test(semantics::Attr::INTRINSIC)) {
+                result->attrs.reset(Procedure::Attr::Elemental);
+              }
               if (!symbol.attrs().test(semantics::Attr::NOPASS)) {
                 auto passName{binding.passName()};
                 for (auto &dummy : result->dummyArguments) {
                   if (!passName || dummy.name.c_str() == *passName) {
                     dummy.pass = true;
-                    return result;
+                    break;
                   }
                 }
-                DIE("PASS argument missing");
               }
               return result;
             } else {
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 84417cd..85aadeb 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -1247,7 +1247,8 @@ bool IsElementalProcedure(const Symbol &original) {
           IsElementalProcedure(*procInterface);
     }
   } else if (const auto *details{symbol.detailsIf<ProcBindingDetails>()}) {
-    return IsElementalProcedure(details->symbol());
+    return !details->symbol().attrs().test(Attr::INTRINSIC) &&
+        IsElementalProcedure(details->symbol());
   } else if (!IsProcedure(symbol)) {
     return false;
   }
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 8c63a74b..3a506c9 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -1661,7 +1661,7 @@ void CheckHelper::CheckProcBinding(
         return;
       }
       if (!IsElementalProcedure(binding.symbol()) &&
-          IsElementalProcedure(overriddenBinding->symbol())) {
+          IsElementalProcedure(*overridden)) {
         SayWithDeclaration(*overridden,
             "A type-bound procedure and its override must both, or neither, be ELEMENTAL"_err_en_US);
         return;
@@ -1674,7 +1674,7 @@ void CheckHelper::CheckProcBinding(
                 : "A passed-argument type-bound procedure may not override a NOPASS procedure"_err_en_US);
       } else {
         const auto *bindingChars{Characterize(binding.symbol())};
-        const auto *overriddenChars{Characterize(overriddenBinding->symbol())};
+        const auto *overriddenChars{Characterize(*overridden)};
         if (bindingChars && overriddenChars) {
           if (isNopass) {
             if (!bindingChars->CanOverride(*overriddenChars, std::nullopt)) {
-- 
2.7.4