[flang] Better name resolution for intrinsics

Original-commit: flang-compiler/f18@31fd9c82e9bd90b03bd37accd3d9f187ccbfa979
Reviewed-on: https://github.com/flang-compiler/f18/pull/561

diff --git a/flang/lib/evaluate/characteristics.cc b/flang/lib/evaluate/characteristics.cc
index 0f9e187..549aee6 100644 (file)
--- a/flang/lib/evaluate/characteristics.cc
+++ b/flang/lib/evaluate/characteristics.cc
@@ -371,6 +371,10 @@ std::optional<Procedure> Procedure::Characterize(
           },
           [&](const semantics::ProcEntityDetails &proc)
               -> std::optional<Procedure> {
+            if (symbol.attrs().test(semantics::Attr::INTRINSIC)) {
+              return intrinsics.IsUnrestrictedSpecificIntrinsicFunction(
+                  symbol.name().ToString());
+            }
             const semantics::ProcInterface &interface{proc.interface()};
             if (const semantics::Symbol * interfaceSymbol{interface.symbol()}) {
               auto characterized{Characterize(*interfaceSymbol, intrinsics)};
@@ -403,21 +407,11 @@ std::optional<Procedure> Procedure::Characterize(
           [&](const semantics::ProcBindingDetails &binding) {
             return Characterize(binding.symbol(), intrinsics);
           },
-          [&](const semantics::MiscDetails &misc) -> std::optional<Procedure> {
-            if (misc.kind() ==
-                semantics::MiscDetails::Kind::SpecificIntrinsic) {
-              return intrinsics.IsUnrestrictedSpecificIntrinsicFunction(
-                  symbol.name().ToString());
-            } else {
-              return std::nullopt;
-            }
-          },
           [](const semantics::GenericDetails &) -> std::optional<Procedure> {
             return std::nullopt;
           },
-          [](const semantics::GenericBindingDetails &) -> std::optional<Procedure> {
-            return std::nullopt;
-          },
+          [](const semantics::GenericBindingDetails &)
+              -> std::optional<Procedure> { return std::nullopt; },
           [](const auto &) -> std::optional<Procedure> { CRASH_NO_CASE; },
       },
       symbol.details());

diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc
index e8ee22a..2cc62aa 100644 (file)
--- a/flang/lib/semantics/expression.cc
+++ b/flang/lib/semantics/expression.cc
@@ -1449,17 +1449,15 @@ auto ExpressionAnalyzer::Procedure(const parser::ProcedureDesignator &pd,
               return std::nullopt;
             }
             const Symbol &symbol{n.symbol->GetUltimate()};
-            if (!symbol.HasExplicitInterface() ||
-                (symbol.has<semantics::MiscDetails>() &&
-                    symbol.get<semantics::MiscDetails>().kind() ==
-                        semantics::MiscDetails::Kind::SpecificIntrinsic)) {
-              // Might be an intrinsic.
+            if (symbol.attrs().test(semantics::Attr::INTRINSIC)) {
               if (std::optional<SpecificCall> specificCall{
                       context_.intrinsics().Probe(CallCharacteristics{n.source},
                           arguments, GetFoldingContext())}) {
                 return CalleeAndArguments{ProcedureDesignator{std::move(
                                               specificCall->specificIntrinsic)},
                     std::move(specificCall->arguments)};
+              } else {
+                return std::nullopt;
               }
             }
             if (symbol.HasExplicitInterface()) {

diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc
index 6e5ff7e..5757093 100644 (file)
--- a/flang/lib/semantics/resolve-names.cc
+++ b/flang/lib/semantics/resolve-names.cc
@@ -1697,6 +1697,7 @@ static bool NeedsType(const Symbol &symbol) {
               [](const AssocEntityDetails &) { return true; },
               [&](const ProcEntityDetails &p) {
                 return symbol.test(Symbol::Flag::Function) &&
+                    !symbol.attrs().test(Attr::INTRINSIC) &&
                     p.interface().type() == nullptr &&
                     p.interface().symbol() == nullptr;
               },
@@ -1708,8 +1709,10 @@ void ScopeHandler::ApplyImplicitRules(Symbol &symbol) {
   if (NeedsType(symbol)) {
     if (isImplicitNoneType()) {
       if (symbol.has<ProcEntityDetails>() &&
+          !symbol.attrs().test(Attr::EXTERNAL) &&
           context().intrinsics().IsIntrinsic(symbol.name().ToString())) {
         // type will be determined in expression semantics
+        symbol.attrs().set(Attr::INTRINSIC);
       } else {
         Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
       }
@@ -3716,13 +3719,9 @@ bool DeclarationVisitor::HandleUnrestrictedSpecificIntrinsicFunction(
           .has_value()) {
     // Unrestricted specific intrinsic function names (e.g., "cos")
     // are acceptable as procedure interfaces.
-    Scope *scope{&currScope()};
-    while (scope->kind() == Scope::Kind::DerivedType) {
-      scope = &scope->parent();
-    }
-    Symbol &symbol{MakeSymbol(*scope, name.source, Attrs{Attr::INTRINSIC})};
-    symbol.set_details(MiscDetails{MiscDetails::Kind::SpecificIntrinsic});
-    CHECK(symbol.HasExplicitInterface());
+    Symbol &symbol{
+        MakeSymbol(InclusiveScope(), name.source, Attrs{Attr::INTRINSIC})};
+    symbol.set_details(ProcEntityDetails{});
     Resolve(name, symbol);
     return true;
   } else {
@@ -4751,20 +4750,26 @@ void ResolveNamesVisitor::HandleProcedureName(
   CHECK(flag == Symbol::Flag::Function || flag == Symbol::Flag::Subroutine);
   auto *symbol{FindSymbol(name)};
   if (symbol == nullptr) {
-    symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{});
+    Attrs attrs;
+    if (context().intrinsics().IsIntrinsic(name.source.ToString())) {
+      attrs.set(Attr::INTRINSIC);
+    }
+    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 (isImplicitNoneExternal() && !symbol->attrs().test(Attr::EXTERNAL)) {
-      Say(name,
-          "'%s' is an external procedure without the EXTERNAL"
-          " attribute in a scope with IMPLICIT NONE(EXTERNAL)"_err_en_US);
-      return;
+    if (!symbol->attrs().test(Attr::INTRINSIC)) {
+      if (isImplicitNoneExternal() && !symbol->attrs().test(Attr::EXTERNAL)) {
+        Say(name,
+            "'%s' is an external procedure without the EXTERNAL"
+            " attribute in a scope with IMPLICIT NONE(EXTERNAL)"_err_en_US);
+        return;
+      }
+      MakeExternal(*symbol);
     }
-    MakeExternal(*symbol);
     if (!symbol->has<ProcEntityDetails>()) {
       ConvertToProcEntity(*symbol);
     }
@@ -4779,9 +4784,7 @@ void ResolveNamesVisitor::HandleProcedureName(
     if (!SetProcFlag(name, *symbol, flag)) {
       return;  // reported error
     }
-    if (symbol->has<SubprogramNameDetails>() || symbol->has<GenericDetails>() ||
-        symbol->has<DerivedTypeDetails>() || symbol->has<SubprogramDetails>() ||
-        symbol->has<ProcEntityDetails>() ||
+    if (IsProcedure(*symbol) || symbol->has<DerivedTypeDetails>() ||
         symbol->has<ObjectEntityDetails>()) {
       // these are all valid as procedure-designators
     } else if (symbol->test(Symbol::Flag::Implicit)) {

diff --git a/flang/lib/semantics/symbol.h b/flang/lib/semantics/symbol.h
index 447a891..7ba88ac 100644 (file)
--- a/flang/lib/semantics/symbol.h
+++ b/flang/lib/semantics/symbol.h
@@ -326,8 +326,8 @@ class FinalProcDetails {};
 class MiscDetails {
 public:
   ENUM_CLASS(Kind, None, ConstructName, ScopeName, PassName, ComplexPartRe,
-      ComplexPartIm, KindParamInquiry, LenParamInquiry, SelectTypeAssociateName,
-      SpecificIntrinsic);
+      ComplexPartIm, KindParamInquiry, LenParamInquiry,
+      SelectTypeAssociateName);
   MiscDetails(Kind kind) : kind_{kind} {}
   Kind kind() const { return kind_; }
 
@@ -540,13 +540,12 @@ public:
         common::visitors{
             [](const SubprogramDetails &) { return true; },
             [](const SubprogramNameDetails &) { return true; },
-            [](const ProcEntityDetails &x) { return x.HasExplicitInterface(); },
+            [&](const ProcEntityDetails &x) {
+              return attrs_.test(Attr::INTRINSIC) || x.HasExplicitInterface();
+            },
             [](const UseDetails &x) {
               return x.symbol().HasExplicitInterface();
             },
-            [](const MiscDetails &x) {
-              return x.kind() == MiscDetails::Kind::SpecificIntrinsic;
-            },
             [](const auto &) { return false; },
         },
         details_);

diff --git a/flang/test/semantics/procinterface01.f90 b/flang/test/semantics/procinterface01.f90
index de24b65..b9cff7c 100644 (file)
--- a/flang/test/semantics/procinterface01.f90
+++ b/flang/test/semantics/procinterface01.f90
@@ -66,13 +66,13 @@ module module1
   !DEF: /module1/derived1/p5 NOPASS, POINTER ProcEntity COMPLEX(4)
   !DEF: /module1/nested4 PUBLIC Subprogram COMPLEX(4)
   procedure(complex), pointer, nopass :: p5 => nested4
+  !DEF: /module1/sin INTRINSIC, PUBLIC ProcEntity
   !DEF: /module1/derived1/p6 NOPASS, POINTER ProcEntity
   !REF: /module1/nested1
-  ! NOTE: sin is not dumped as a DEF here because specific
-  ! intrinsic functions are represented with MiscDetails
-  ! and those are omitted from dumping.
   procedure(sin), pointer, nopass :: p6 => nested1
+  !REF: /module1/sin
   !DEF: /module1/derived1/p7 NOPASS, POINTER ProcEntity
+  !DEF: /module1/cos INTRINSIC, PUBLIC ProcEntity
   procedure(sin), pointer, nopass :: p7 => cos
   !REF: /module1/tan
   !DEF: /module1/derived1/p8 NOPASS, POINTER ProcEntity CHARACTER(1_4,1)
@@ -118,7 +118,7 @@ contains
   !REF: /module1/nested4/x
   real, intent(in) :: x
   !DEF: /module1/nested4/nested4 ObjectEntity COMPLEX(4)
-  !DEF: /cmplx EXTERNAL (implicit) ProcEntity REAL(4)
+  !DEF: /cmplx INTRINSIC ProcEntity
   !REF: /module1/nested4/x
   nested4 = cmplx(x+4., 6.)
  end function nested4

diff --git a/flang/test/semantics/symbol13.f90 b/flang/test/semantics/symbol13.f90
index c6a136c..680119b 100644 (file)
--- a/flang/test/semantics/symbol13.f90
+++ b/flang/test/semantics/symbol13.f90
@@ -23,7 +23,7 @@ character*1 function f1(x1, x2)
  !REF: /f1/n
  !REF: /f1/x1
  !REF: /f1/x2
- !DEF: /len EXTERNAL (implicit) ProcEntity INTEGER(4)
+ !DEF: /len INTRINSIC ProcEntity
  character*(n), intent(in) :: x1, x2*(len(x1)+1)
  !DEF: /f1/t DerivedType
  type :: t