[flang] Tighten rules to resolve procedure as intrinsic procedure

2 Bug fixes:

- Do not resolve procedure as intrinsic if they appeared in an
  EXTERNAL attribute statement (one path was not considering this flag)

- Emit an error if a procedure resolved to be an intrinsic function
  (resp. subroutine) is used as a subroutine (resp. function).
  Lowering was attempted while the evaluate::Expression for the
  call was missing without any errors.

1 behavior change:

- Do not implicitly resolve subroutines (resp. functions) as intrinsics
  because their name is the name of an intrinsic function (resp.
  subroutine). Add justification in documentation.

Reviewed By: klausler, tskeith

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

flang/docs/Intrinsics.md

@@ -694,6 +694,46 @@ CACHESIZE, EOF, FP_CLASS, INT_PTR_KIND, ISNAN, LOC
 MALLOC
 ```
 
+## Intrinsic Procedure Name Resolution
+
+When the name of a procedure in a program is the same as the one of an intrinsic
+procedure, and nothing other than its usage allows to decide whether the procedure
+is the intrinsic or not (i.e, it does not appear in an INTRINSIC or EXTERNAL attribute
+statement, is not an use/host associated procedure...), Fortran 2018 standard
+section 19.5.1.4 point 6 rules that the procedure is established to be intrinsic if it is
+invoked as an intrinsic procedure.
+
+In case the invocation would be an error if the procedure were the intrinsic
+(e.g. wrong argument number or type), the broad wording of the standard
+leaves two choices to the compiler: emit an error about the intrinsic invocation,
+or consider this is an external procedure and emit no error.
+
+f18 will always consider this case to be the intrinsic and emit errors, unless the procedure
+is used as a function (resp. subroutine) and the intrinsic is a subroutine (resp. function).
+The table below gives some examples of decisions made by Fortran compilers in such case.
+
+| What is ACOS ?     | Bad intrinsic call       | External with warning |  External no warning | Other error |
+| --- | --- | --- | --- | --- |
+| `print*, ACOS()`     | gfortran, nag, xlf, f18  |  ifort                |  nvfortran           | |
+| `print*, ACOS(I)`    | gfortran, nag, xlf, f18  |  ifort                |  nvfortran           | |
+| `print*, ACOS(X=I)`  | gfortran, nag, xlf, f18  |  ifort                |                      | nvfortran (keyword on implicit extrenal )|
+| `print*, ACOS(X, X)` | gfortran, nag, xlf, f18  |  ifort                |  nvfortran           | |
+| `CALL ACOS(X)`       |                          |                       |  gfortran, nag, xlf, nvfortran, ifort, f18  | |
+
+
+The rationale for f18 behavior is that when referring to a procedure with an
+argument number or type that does not match the intrinsic specification, it seems safer to block
+the rather likely case where the user is using the intrinsic the wrong way.
+In case the user wanted to refer to an external function, he can add an explicit EXTERNAL
+statement with no other consequences on the program.
+However, it seems rather unlikely that a user would confuse an intrinsic subroutine for a
+function and vice versa. Given no compiler is issuing an error here, changing the behavior might
+affect existing programs that omit the EXTERNAL attribute in such case.
+
+Also note that in general, the standard gives the compiler the right to consider
+any procedure that is not explicitly external as a non standard intrinsic (section 4.2 point 4).
+So it is highly advised for the programmer to use EXTERNAL statements to prevent any ambiguity.
+
 ## Intrinsic Procedure Support in f18
 This section gives an overview of the support inside f18 libraries for the
 intrinsic procedures listed above.

flang/include/flang/Evaluate/intrinsics.h

@@ -77,6 +77,8 @@ public:
   // Check whether a name should be allowed to appear on an INTRINSIC
   // statement.
   bool IsIntrinsic(const std::string &) const;
+  bool IsIntrinsicFunction(const std::string &) const;
+  bool IsIntrinsicSubroutine(const std::string &) const;
 
   // Inquiry intrinsics are defined in section 16.7, table 16.1
   IntrinsicClass GetIntrinsicClass(const std::string &) const;

flang/lib/Evaluate/intrinsics.cpp

@@ -1616,6 +1616,8 @@ public:
   }
 
   bool IsIntrinsic(const std::string &) const;
+  bool IsIntrinsicFunction(const std::string &) const;
+  bool IsIntrinsicSubroutine(const std::string &) const;
 
   IntrinsicClass GetIntrinsicClass(const std::string &) const;
   std::string GetGenericIntrinsicName(const std::string &) const;
@@ -1641,7 +1643,7 @@ private:
   std::multimap<std::string, const IntrinsicInterface *> subroutines_;
 };
 
-bool IntrinsicProcTable::Implementation::IsIntrinsic(
+bool IntrinsicProcTable::Implementation::IsIntrinsicFunction(
     const std::string &name) const {
   auto specificRange{specificFuncs_.equal_range(name)};
   if (specificRange.first != specificRange.second) {
@@ -1651,12 +1653,21 @@ bool IntrinsicProcTable::Implementation::IsIntrinsic(
   if (genericRange.first != genericRange.second) {
     return true;
   }
+  // special cases
+  return name == "null";
+}
+bool IntrinsicProcTable::Implementation::IsIntrinsicSubroutine(
+    const std::string &name) const {
   auto subrRange{subroutines_.equal_range(name)};
   if (subrRange.first != subrRange.second) {
     return true;
   }
   // special cases
-  return name == "null" || name == "__builtin_c_f_pointer";
+  return name == "__builtin_c_f_pointer";
+}
+bool IntrinsicProcTable::Implementation::IsIntrinsic(
+    const std::string &name) const {
+  return IsIntrinsicFunction(name) || IsIntrinsicSubroutine(name);
 }
 
 IntrinsicClass IntrinsicProcTable::Implementation::GetIntrinsicClass(
@@ -2083,6 +2094,11 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::Probe(
         return specificCall;
       }
     }
+    if (IsIntrinsicFunction(call.name)) {
+      context.messages().Say(
+          "Cannot use intrinsic function '%s' as a subroutine"_err_en_US,
+          call.name);
+    }
     return std::nullopt; // TODO
   }
 
@@ -2171,6 +2187,13 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::Probe(
     }
   }
 
+  if (specificBuffer.empty() && genericBuffer.empty() &&
+      IsIntrinsicSubroutine(call.name)) {
+    context.messages().Say(
+        "Cannot use intrinsic subroutine '%s' as a function"_err_en_US,
+        call.name);
+  }
+
   // No match; report the right errors, if any
   if (finalBuffer) {
     if (specificBuffer.empty()) {
@@ -2233,6 +2256,12 @@ IntrinsicProcTable IntrinsicProcTable::Configure(
 bool IntrinsicProcTable::IsIntrinsic(const std::string &name) const {
   return DEREF(impl_).IsIntrinsic(name);
 }
+bool IntrinsicProcTable::IsIntrinsicFunction(const std::string &name) const {
+  return DEREF(impl_).IsIntrinsicFunction(name);
+}
+bool IntrinsicProcTable::IsIntrinsicSubroutine(const std::string &name) const {
+  return DEREF(impl_).IsIntrinsicSubroutine(name);
+}
 
 IntrinsicClass IntrinsicProcTable::GetIntrinsicClass(
     const std::string &name) const {

flang/lib/Semantics/resolve-names.cpp

@@ -157,8 +157,17 @@ public:
   evaluate::FoldingContext &GetFoldingContext() const {
     return context_->foldingContext();
   }
-  bool IsIntrinsic(const SourceName &name) const {
-    return context_->intrinsics().IsIntrinsic(name.ToString());
+  bool IsIntrinsic(
+      const SourceName &name, std::optional<Symbol::Flag> flag) const {
+    if (!flag) {
+      return context_->intrinsics().IsIntrinsic(name.ToString());
+    } else if (flag == Symbol::Flag::Function) {
+      return context_->intrinsics().IsIntrinsicFunction(name.ToString());
+    } else if (flag == Symbol::Flag::Subroutine) {
+      return context_->intrinsics().IsIntrinsicSubroutine(name.ToString());
+    } else {
+      DIE("expected Subroutine or Function flag");
+    }
   }
 
   // Make a placeholder symbol for a Name that otherwise wouldn't have one.
@@ -2096,11 +2105,23 @@ void ScopeHandler::ApplyImplicitRules(Symbol &symbol) {
     if (const DeclTypeSpec * type{GetImplicitType(symbol)}) {
       symbol.set(Symbol::Flag::Implicit);
       symbol.SetType(*type);
-    } else if (symbol.has<ProcEntityDetails>() &&
-        !symbol.attrs().test(Attr::EXTERNAL) && IsIntrinsic(symbol.name())) {
-      // type will be determined in expression semantics
-      symbol.attrs().set(Attr::INTRINSIC);
-    } else if (!context().HasError(symbol)) {
+      return;
+    }
+    if (symbol.has<ProcEntityDetails>() &&
+        !symbol.attrs().test(Attr::EXTERNAL)) {
+      std::optional<Symbol::Flag> functionOrSubroutineFlag;
+      if (symbol.test(Symbol::Flag::Function)) {
+        functionOrSubroutineFlag = Symbol::Flag::Function;
+      } else if (symbol.test(Symbol::Flag::Subroutine)) {
+        functionOrSubroutineFlag = Symbol::Flag::Subroutine;
+      }
+      if (IsIntrinsic(symbol.name(), functionOrSubroutineFlag)) {
+        // type will be determined in expression semantics
+        symbol.attrs().set(Attr::INTRINSIC);
+        return;
+      }
+    }
+    if (!context().HasError(symbol)) {
       Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
       context().SetError(symbol);
     }
@@ -3321,7 +3342,7 @@ bool DeclarationVisitor::HandleAttributeStmt(
 }
 Symbol &DeclarationVisitor::HandleAttributeStmt(
     Attr attr, const parser::Name &name) {
-  if (attr == Attr::INTRINSIC && !IsIntrinsic(name.source)) {
+  if (attr == Attr::INTRINSIC && !IsIntrinsic(name.source, std::nullopt)) {
     Say(name.source, "'%s' is not a known intrinsic procedure"_err_en_US);
   }
   auto *symbol{FindInScope(currScope(), name)};
@@ -5779,7 +5800,7 @@ void ResolveNamesVisitor::HandleProcedureName(
   CHECK(flag == Symbol::Flag::Function || flag == Symbol::Flag::Subroutine);
   auto *symbol{FindSymbol(NonDerivedTypeScope(), name)};
   if (!symbol) {
-    if (IsIntrinsic(name.source)) {
+    if (IsIntrinsic(name.source, flag)) {
       symbol =
           &MakeSymbol(InclusiveScope(), name.source, Attrs{Attr::INTRINSIC});
     } else {
@@ -5808,8 +5829,9 @@ void ResolveNamesVisitor::HandleProcedureName(
     // error was reported
   } else {
     symbol = &Resolve(name, symbol)->GetUltimate();
-    if (ConvertToProcEntity(*symbol) && IsIntrinsic(symbol->name()) &&
-        !IsDummy(*symbol)) {
+    bool convertedToProcEntity{ConvertToProcEntity(*symbol)};
+    if (convertedToProcEntity && !symbol->attrs().test(Attr::EXTERNAL) &&
+        IsIntrinsic(symbol->name(), flag) && !IsDummy(*symbol)) {
       symbol->attrs().set(Attr::INTRINSIC);
       // 8.2(3): ignore type from intrinsic in type-declaration-stmt
       symbol->get<ProcEntityDetails>().set_interface(ProcInterface{});

flang/test/Semantics/call16.f90

@@ -0,0 +1,13 @@
+! RUN: %S/test_errors.sh %s %t %f18
+
+! Test that intrinsic functions used as subroutines and vice versa are caught.
+
+subroutine test(x, t)
+ intrinsic :: sin, cpu_time
+ !ERROR: Cannot use intrinsic function 'sin' as a subroutine
+ call sin(x)
+ !ERROR: Cannot use intrinsic subroutine 'cpu_time' as a function
+ x = cpu_time(t)
+end subroutine
+
+

flang/test/Semantics/symbol19.f90

@@ -0,0 +1,52 @@
+! RUN: %S/test_symbols.sh %s %t %f18
+
+
+! Test that a procedure is only implicitly resolved as an intrinsic function
+! (resp. subroutine) if this is a function (resp. subroutine)
+
+!DEF: /expect_external (Subroutine) Subprogram
+subroutine expect_external
+ !DEF: /acos EXTERNAL (Subroutine) ProcEntity
+ !DEF: /expect_external/x (Implicit) ObjectEntity REAL(4)
+ call acos(x)
+ !DEF: /expect_external/i (Implicit) ObjectEntity INTEGER(4)
+ !DEF: /system_clock EXTERNAL (Function, Implicit) ProcEntity REAL(4)
+ !DEF: /expect_external/icount (Implicit) ObjectEntity INTEGER(4)
+ i = system_clock(icount)
+end subroutine
+
+!DEF: /expect_intrinsic (Subroutine) Subprogram
+subroutine expect_intrinsic
+ !DEF: /expect_intrinsic/y (Implicit) ObjectEntity REAL(4)
+ !DEF: /expect_intrinsic/acos INTRINSIC (Function) ProcEntity
+ !DEF: /expect_intrinsic/x (Implicit) ObjectEntity REAL(4)
+ y = acos(x)
+ !DEF: /expect_intrinsic/system_clock INTRINSIC (Subroutine) ProcEntity
+ !DEF: /expect_intrinsic/icount (Implicit) ObjectEntity INTEGER(4)
+ call system_clock(icount)
+end subroutine
+
+! Sanity check that the EXTERNAL attribute is not bypassed by
+! implicit intrinsic resolution, even if it otherwise perfectly
+! matches an intrinsic call.
+
+!DEF: /expect_external_2 (Subroutine) Subprogram
+subroutine expect_external_2
+ !DEF: /expect_external_2/matmul EXTERNAL (Function, Implicit) ProcEntity INTEGER(4)
+ external :: matmul
+ !DEF: /expect_external_2/cpu_time EXTERNAL (Subroutine) ProcEntity
+ external :: cpu_time
+ !DEF: /expect_external_2/x ObjectEntity REAL(4)
+ !DEF: /expect_external_2/y ObjectEntity REAL(4)
+ !DEF: /expect_external_2/z ObjectEntity REAL(4)
+ !DEF: /expect_external_2/t ObjectEntity REAL(4)
+ real x(2,2), y(2), z(2), t
+ !REF: /expect_external_2/z
+ !REF: /expect_external_2/matmul
+ !REF: /expect_external_2/x
+ !REF: /expect_external_2/y
+ z = matmul(x, y)
+ !REF: /expect_external_2/cpu_time
+ !REF: /expect_external_2/t
+ call cpu_time(t)
+end subroutine