diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md --- a/flang/docs/Intrinsics.md +++ b/flang/docs/Intrinsics.md @@ -694,6 +694,46 @@ 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. diff --git a/flang/include/flang/Evaluate/intrinsics.h b/flang/include/flang/Evaluate/intrinsics.h --- a/flang/include/flang/Evaluate/intrinsics.h +++ b/flang/include/flang/Evaluate/intrinsics.h @@ -72,6 +72,8 @@ // 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; diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -1616,6 +1616,8 @@ } 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 @@ std::multimap 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 @@ 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 @@ 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 @@ } } + 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()) { @@ -2237,6 +2260,12 @@ 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 { diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -157,8 +157,17 @@ 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 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. @@ -2096,11 +2105,23 @@ if (const DeclTypeSpec * type{GetImplicitType(symbol)}) { symbol.set(Symbol::Flag::Implicit); symbol.SetType(*type); - } else if (symbol.has() && - !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() && + !symbol.attrs().test(Attr::EXTERNAL)) { + std::optional 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 @@ } 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 @@ 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 @@ // 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().set_interface(ProcInterface{}); diff --git a/flang/test/Semantics/call16.f90 b/flang/test/Semantics/call16.f90 new file mode 100644 --- /dev/null +++ b/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 + + diff --git a/flang/test/Semantics/symbol19.f90 b/flang/test/Semantics/symbol19.f90 new file mode 100644 --- /dev/null +++ b/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