[flang-commits] [flang] 1e082a4 - [flang] Fix result type of "procedure(abs) :: f"

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-03-02T11:11:40-08:00
New Revision: 1e082a4a9c2d5b3dba06561bc3a3764c4cdc0d25

URL: https://github.com/llvm/llvm-project/commit/1e082a4a9c2d5b3dba06561bc3a3764c4cdc0d25
DIFF: https://github.com/llvm/llvm-project/commit/1e082a4a9c2d5b3dba06561bc3a3764c4cdc0d25.diff

LOG: [flang] Fix result type of "procedure(abs) :: f"

Name resolution was properly probing the table of unrestricted
specific intrinsics to find "abs", but failing to capture the
result type and save it in the created symbol table entry.

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

Added: 
    

Modified: 
    flang/lib/Semantics/resolve-names.cpp
    flang/test/Semantics/procinterface01.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 2c3925469532e..544b5d333e458 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -5124,10 +5124,24 @@ bool DeclarationVisitor::HandleUnrestrictedSpecificIntrinsicFunction(
   if (auto interface{context().intrinsics().IsSpecificIntrinsicFunction(
           name.source.ToString())}) {
     // Unrestricted specific intrinsic function names (e.g., "cos")
-    // are acceptable as procedure interfaces.
+    // are acceptable as procedure interfaces.  The presence of the
+    // INTRINSIC flag will cause this symbol to have a complete interface
+    // recreated for it later on demand, but capturing its result type here
+    // will make GetType() return a correct result without having to
+    // probe the intrinsics table again.
     Symbol &symbol{
         MakeSymbol(InclusiveScope(), name.source, Attrs{Attr::INTRINSIC})};
-    symbol.set_details(ProcEntityDetails{});
+    CHECK(interface->functionResult.has_value());
+    evaluate::DynamicType dyType{
+        DEREF(interface->functionResult->GetTypeAndShape()).type()};
+    CHECK(common::IsNumericTypeCategory(dyType.category()));
+    const DeclTypeSpec &typeSpec{
+        MakeNumericType(dyType.category(), dyType.kind())};
+    ProcEntityDetails details;
+    ProcInterface procInterface;
+    procInterface.set_type(typeSpec);
+    details.set_interface(procInterface);
+    symbol.set_details(std::move(details));
     symbol.set(Symbol::Flag::Function);
     if (interface->IsElemental()) {
       symbol.attrs().set(Attr::ELEMENTAL);

diff  --git a/flang/test/Semantics/procinterface01.f90 b/flang/test/Semantics/procinterface01.f90
index 7fc3c75e1e0f8..e75a13066a9a5 100644
--- a/flang/test/Semantics/procinterface01.f90
+++ b/flang/test/Semantics/procinterface01.f90
@@ -53,13 +53,13 @@ end function tan
   !DEF: /module1/derived1/p5 NOPASS, POINTER (Function) ProcEntity COMPLEX(4)
   !DEF: /module1/nested4 PUBLIC (Function) Subprogram COMPLEX(4)
   procedure(complex), pointer, nopass :: p5 => nested4
-  !DEF: /module1/sin ELEMENTAL, INTRINSIC, PUBLIC, PURE (Function) ProcEntity
-  !DEF: /module1/derived1/p6 NOPASS, POINTER (Function) ProcEntity
+  !DEF: /module1/sin ELEMENTAL, INTRINSIC, PUBLIC, PURE (Function) ProcEntity REAL(4)
+  !DEF: /module1/derived1/p6 NOPASS, POINTER (Function) ProcEntity REAL(4)
   !REF: /module1/nested1
   procedure(sin), pointer, nopass :: p6 => nested1
   !REF: /module1/sin
-  !DEF: /module1/derived1/p7 NOPASS, POINTER (Function) ProcEntity
-  !DEF: /module1/cos ELEMENTAL, INTRINSIC, PUBLIC, PURE (Function) ProcEntity
+  !DEF: /module1/derived1/p7 NOPASS, POINTER (Function) ProcEntity REAL(4)
+  !DEF: /module1/cos ELEMENTAL, INTRINSIC, PUBLIC, PURE (Function) ProcEntity REAL(4)
   procedure(sin), pointer, nopass :: p7 => cos
   !REF: /module1/tan
   !DEF: /module1/derived1/p8 NOPASS, POINTER (Function) ProcEntity CHARACTER(1_4,1)