[flang] Tighten rules to resolve procedure as intrinsic procedure

[jeanPerier]

Summary

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.

[tskeith]

flang/lib/Semantics/resolve-names.cpp

169

Typo: Symbol -> Subroutine

[klausler]

Looks great to me; thanks!

flang/docs/Intrinsics.md

711

English: "f18 will always consider this case to be the intrinsic..."

724

sp. "rationale".

734

"procedure" should be singular

735

"resolve" or "prevent" or "forestall", not "raise"

[jeanPerier]

Thanks for the reviews. Fix typos in documentation an error message.

flang/docs/Intrinsics.md

 LSHIFT, RSHIFT
 IBCHNG, ISHA, ISHC, ISHL, IXOR
 IARG, IARGC, NARGS, NUMARG
 BADDRESS, IADDR
 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 and error about the intrinsic invocation,
+or consider this is an external procedure and emit no error.
+
+f18 will always consider this is 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 rational 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 procedures 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 raise any ambiguity.
+
 ## Intrinsic Procedure Support in f18
 This section gives an overview of the support inside f18 libraries for the
 intrinsic procedures listed above.
 It may be outdated, refer to f18 code base for the actual support status.
 
 ### Semantic Analysis
 F18 semantic expression analysis phase detects intrinsic procedure references,
 validates the argument types and deduces the return types.

flang/include/flang/Evaluate/intrinsics.h

 public:
   ~IntrinsicProcTable();
   static IntrinsicProcTable Configure(
       const common::IntrinsicTypeDefaultKinds &);
 
   // 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;
 
   // Return the generic name of a specific intrinsic name.
   // The name provided is returned if it is a generic intrinsic name or is
   // not known to be an intrinsic.
   std::string GetGenericIntrinsicName(const std::string &) const;

flang/lib/Evaluate/intrinsics.cpp

for (const SpecificIntrinsicInterface &f : specificIntrinsicFunction) {
       specificFuncs_.insert(std::make_pair(std::string{f.name}, &f));
     }
     for (const IntrinsicInterface &f : intrinsicSubroutine) {
       subroutines_.insert(std::make_pair(std::string{f.name}, &f));
     }
   }
 
   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;
 
   std::optional<SpecificCall> Probe(const CallCharacteristics &,
       ActualArguments &, FoldingContext &, const IntrinsicProcTable &) const;
 
   std::optional<SpecificIntrinsicFunctionInterface> IsSpecificIntrinsicFunction(
std::optional<SpecificCall> HandleC_F_Pointer(
       ActualArguments &, FoldingContext &) const;
 
   common::IntrinsicTypeDefaultKinds defaults_;
   std::multimap<std::string, const IntrinsicInterface *> genericFuncs_;
   std::multimap<std::string, const SpecificIntrinsicInterface *> specificFuncs_;
   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) {
     return true;
   }
   auto genericRange{genericFuncs_.equal_range(name)};
   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(
     const std::string &name) const {
   auto specificIntrinsic{specificFuncs_.find(name)};
   if (specificIntrinsic != specificFuncs_.end()) {
     return specificIntrinsic->second->intrinsicClass;
   }
std::optional<SpecificCall> IntrinsicProcTable::Implementation::Probe(
   if (call.isSubroutineCall) {
     auto subrRange{subroutines_.equal_range(call.name)};
     for (auto iter{subrRange.first}; iter != subrRange.second; ++iter) {
       if (auto specificCall{
               iter->second->Match(call, defaults_, arguments, context)}) {
         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
   }
 
   // Helper to avoid emitting errors before it is sure there is no match
   parser::Messages localBuffer;
   parser::Messages *finalBuffer{context.messages().messages()};
   parser::ContextualMessages localMessages{
       context.messages().at(), finalBuffer ? &localBuffer : nullptr};
if (const char *genericName{specIter->second->generic}) {
                 .SetType(newType);
             return specificCall;
           }
         }
       }
     }
   }
 
+  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()) {
       finalBuffer->Annex(std::move(genericBuffer));
     } else {
       finalBuffer->Annex(std::move(specificBuffer));
     }
   }
IntrinsicProcTable IntrinsicProcTable::Configure(
   IntrinsicProcTable result;
   result.impl_ = new IntrinsicProcTable::Implementation(defaults);
   return result;
 }
 
 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 {
   return DEREF(impl_).GetIntrinsicClass(name);
 }
 
 std::string IntrinsicProcTable::GetGenericIntrinsicName(
     const std::string &name) const {

flang/lib/Semantics/resolve-names.cpp

public:
   MessageHandler &messageHandler() { return messageHandler_; }
   const std::optional<SourceName> &currStmtSource() {
     return context_->location();
   }
   SemanticsContext &context() const { return *context_; }
   evaluate::FoldingContext &GetFoldingContext() const {
     return context_->foldingContext();
   }
-  bool IsIntrinsic(const SourceName &name) const {
+  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 Symbol or Function flag");
+    }
   }
 
   // Make a placeholder symbol for a Name that otherwise wouldn't have one.
   // It is not in any scope and always has MiscDetails.
   void MakePlaceholder(const parser::Name &, MiscDetails::Kind);
 
   template <typename T> common::IfNoLvalue<T, T> FoldExpr(T &&expr) {
     return evaluate::Fold(GetFoldingContext(), std::move(expr));
return !symbol.GetType() &&
           symbol.details());
 }
 
 void ScopeHandler::ApplyImplicitRules(Symbol &symbol) {
   if (NeedsType(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())) {
+      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);
-    } else if (!context().HasError(symbol)) {
+        return;
+      }
+    }
+    if (!context().HasError(symbol)) {
       Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
       context().SetError(symbol);
     }
   }
 }
 
 const DeclTypeSpec *ScopeHandler::GetImplicitType(Symbol &symbol) {
   const auto *type{implicitRulesMap_->at(&GetInclusiveScope(symbol.owner()))
bool DeclarationVisitor::HandleAttributeStmt(
     Attr attr, const std::list<parser::Name> &names) {
   for (const auto &name : names) {
     HandleAttributeStmt(attr, name);
   }
   return false;
 }
 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)};
   if (attr == Attr::ASYNCHRONOUS || attr == Attr::VOLATILE) {
     // these can be set on a symbol that is host-assoc or use-assoc
     if (!symbol &&
         (currScope().kind() == Scope::Kind::Subprogram ||
             currScope().kind() == Scope::Kind::Block)) {
void ResolveNamesVisitor::HandleCall(
   Walk(std::get<std::list<parser::ActualArgSpec>>(call.t));
 }
 
 void ResolveNamesVisitor::HandleProcedureName(
     Symbol::Flag flag, const parser::Name &name) {
   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 {
       symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{});
     }
     Resolve(name, *symbol);
     if (symbol->has<ModuleDetails>()) {
       SayWithDecl(name, *symbol,
if (!symbol) {
     ConvertToProcEntity(*symbol);
     SetProcFlag(name, *symbol, flag);
   } else if (symbol->has<UnknownDetails>()) {
     DIE("unexpected UnknownDetails");
   } else if (CheckUseError(name)) {
     // 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{});
     }
     if (!SetProcFlag(name, *symbol, flag)) {
       return; // reported error
     }
     if (IsProcedure(*symbol) || symbol->has<DerivedTypeDetails>() ||

flang/test/Semantics/call16.f90

+! 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

+! 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