[flang-commits] [flang] 878b526 - [flang] Tighten rules to resolve procedure as intrinsic procedure
Jean Perier via flang-commits
flang-commits at lists.llvm.org
Mon Oct 26 03:27:05 PDT 2020
Author: Jean Perier
Date: 2020-10-26T11:25:40+01:00
New Revision: 878b526409acb04b11f0a6b83c561bfee3521e57
URL: https://github.com/llvm/llvm-project/commit/878b526409acb04b11f0a6b83c561bfee3521e57
DIFF: https://github.com/llvm/llvm-project/commit/878b526409acb04b11f0a6b83c561bfee3521e57.diff
LOG: [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
Added:
flang/test/Semantics/call16.f90
flang/test/Semantics/symbol19.f90
Modified:
flang/docs/Intrinsics.md
flang/include/flang/Evaluate/intrinsics.h
flang/lib/Evaluate/intrinsics.cpp
flang/lib/Semantics/resolve-names.cpp
Removed:
################################################################################
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index f9e47e5893bf..5b353e89311a 100644
--- a/flang/docs/Intrinsics.md
+++ b/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.
diff --git a/flang/include/flang/Evaluate/intrinsics.h b/flang/include/flang/Evaluate/intrinsics.h
index 14aff0db0175..1a71d91ed560 100644
--- a/flang/include/flang/Evaluate/intrinsics.h
+++ b/flang/include/flang/Evaluate/intrinsics.h
@@ -77,6 +77,8 @@ class IntrinsicProcTable {
// 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
index 7c00ac6d8195..8154b7d5bbcb 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1616,6 +1616,8 @@ class IntrinsicProcTable::Implementation {
}
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 @@ class IntrinsicProcTable::Implementation {
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 {
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 40ece09d1b8d..6462d7885d20 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -157,8 +157,17 @@ class BaseVisitor {
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{});
diff --git a/flang/test/Semantics/call16.f90 b/flang/test/Semantics/call16.f90
new file mode 100644
index 000000000000..c1ace8cc4668
--- /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
index 000000000000..539edd1ed64e
--- /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
More information about the flang-commits
mailing list