[flang-commits] [flang] d325c5d - [flang] Extension: unrestricted intrinsics as specifics in generics
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Tue Aug 8 10:46:32 PDT 2023
Author: Peter Klausler
Date: 2023-08-08T10:46:24-07:00
New Revision: d325c5d00b148ae430b749817bb4182a4af4eeff
URL: https://github.com/llvm/llvm-project/commit/d325c5d00b148ae430b749817bb4182a4af4eeff
DIFF: https://github.com/llvm/llvm-project/commit/d325c5d00b148ae430b749817bb4182a4af4eeff.diff
LOG: [flang] Extension: unrestricted intrinsics as specifics in generics
At least one other Fortran compiler supports the use of unrestricted intrinsic
functions as specific procedures in generic interfaces, and the usage seems
to be both useful and unambiguous. Support it with a portability warning.
Fixes llvm-test-suite/Fortran/gfortran/regression/pr95500.f90.
Differential Revision: https://reviews.llvm.org/D157333
Added:
Modified:
flang/docs/Extensions.md
flang/lib/Semantics/check-declarations.cpp
flang/lib/Semantics/expression.cpp
flang/lib/Semantics/resolve-names.cpp
flang/test/Semantics/call16.f90
flang/test/Semantics/generic06.f90
Removed:
################################################################################
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 4646e0ba501b9f..49e78a10fa6bcd 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -295,6 +295,9 @@ end
by a line continuation in free form, the second quotation mark
may appear at the beginning of the continuation line without an
ampersand, althought one is required by the standard.
+* Unrestricted `INTRINSIC` functions are accepted for use in
+ `PROCEDURE` statements in generic interfaces, as in some other
+ compilers.
### Extensions supported when enabled by options
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index d9259f40cc309e..3713990a9823f7 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -1726,12 +1726,25 @@ void CheckHelper::CheckSpecifics(
continue;
}
if (specific.attrs().test(Attr::INTRINSIC)) {
- if (auto *msg{messages_.Say(specific.name(),
- "Specific procedure '%s' of generic interface '%s' may not be INTRINSIC"_err_en_US,
- specific.name(), generic.name())}) {
- msg->Attach(generic.name(), "Definition of '%s'"_en_US, generic.name());
+ // GNU Fortran allows INTRINSIC procedures in generics.
+ auto intrinsic{context_.intrinsics().IsSpecificIntrinsicFunction(
+ specific.name().ToString())};
+ if (intrinsic && !intrinsic->isRestrictedSpecific) {
+ if (auto *msg{messages_.Say(specific.name(),
+ "Specific procedure '%s' of generic interface '%s' should not be INTRINSIC"_port_en_US,
+ specific.name(), generic.name())}) {
+ msg->Attach(
+ generic.name(), "Definition of '%s'"_en_US, generic.name());
+ }
+ } else {
+ if (auto *msg{messages_.Say(specific.name(),
+ "Procedure '%s' of generic interface '%s' is INTRINSIC but not an unrestricted specific intrinsic function"_port_en_US,
+ specific.name(), generic.name())}) {
+ msg->Attach(
+ generic.name(), "Definition of '%s'"_en_US, generic.name());
+ }
+ continue;
}
- continue;
}
if (IsStmtFunction(specific)) {
if (auto *msg{messages_.Say(specific.name(),
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 44377836c62a0f..5dfc58b6d74fdb 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -2608,10 +2608,10 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
resolution = symbol;
}
if (!resolution || resolution->attrs().test(semantics::Attr::INTRINSIC)) {
- // Not generic, or no resolution; may be intrinsic
+ auto name{resolution ? resolution->name() : ultimate.name()};
if (std::optional<SpecificCall> specificCall{context_.intrinsics().Probe(
- CallCharacteristics{ultimate.name().ToString(), isSubroutine},
- arguments, GetFoldingContext())}) {
+ CallCharacteristics{name.ToString(), isSubroutine}, arguments,
+ GetFoldingContext())}) {
CheckBadExplicitType(*specificCall, *symbol);
return CalleeAndArguments{
ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 22f3e419cddb86..b6e0bf19730c3e 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -4619,15 +4619,27 @@ bool DeclarationVisitor::Pre(const parser::IntrinsicStmt &x) {
Say(symbol.name(),
"Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US,
symbol.name());
- } else if (symbol.GetType()) {
- // These warnings are worded so that they should make sense in either
- // order.
- Say(symbol.name(),
- "Explicit type declaration ignored for intrinsic function '%s'"_warn_en_US,
- symbol.name())
- .Attach(name.source,
- "INTRINSIC statement for explicitly-typed '%s'"_en_US,
- name.source);
+ } else {
+ if (symbol.GetType()) {
+ // These warnings are worded so that they should make sense in either
+ // order.
+ Say(symbol.name(),
+ "Explicit type declaration ignored for intrinsic function '%s'"_warn_en_US,
+ symbol.name())
+ .Attach(name.source,
+ "INTRINSIC statement for explicitly-typed '%s'"_en_US,
+ name.source);
+ }
+ if (!symbol.test(Symbol::Flag::Function) &&
+ !symbol.test(Symbol::Flag::Subroutine)) {
+ if (context().intrinsics().IsIntrinsicFunction(
+ name.source.ToString())) {
+ symbol.set(Symbol::Flag::Function);
+ } else if (context().intrinsics().IsIntrinsicSubroutine(
+ name.source.ToString())) {
+ symbol.set(Symbol::Flag::Subroutine);
+ }
+ }
}
}
return false;
diff --git a/flang/test/Semantics/call16.f90 b/flang/test/Semantics/call16.f90
index 37e82b16682067..12e8c320c97848 100644
--- a/flang/test/Semantics/call16.f90
+++ b/flang/test/Semantics/call16.f90
@@ -4,9 +4,9 @@
subroutine test(x, t)
intrinsic :: sin, cpu_time
- !ERROR: Cannot use intrinsic function 'sin' as a subroutine
+ !ERROR: Cannot call function 'sin' like a subroutine
call sin(x)
- !ERROR: Cannot use intrinsic subroutine 'cpu_time' as a function
+ !ERROR: Cannot call subroutine 'cpu_time' like a function
x = cpu_time(t)
end subroutine
diff --git a/flang/test/Semantics/generic06.f90 b/flang/test/Semantics/generic06.f90
index 7f4f54b3b52a0e..3e39cc71974477 100644
--- a/flang/test/Semantics/generic06.f90
+++ b/flang/test/Semantics/generic06.f90
@@ -1,11 +1,11 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
module m
- !ERROR: Specific procedure 'sin' of generic interface 'yintercept' may not be INTRINSIC
+ !PORTABILITY: Specific procedure 'sin' of generic interface 'yintercept' should not be INTRINSIC
intrinsic sin
interface yIntercept
procedure sin
end interface
- !ERROR: Specific procedure 'cos' of generic interface 'xintercept' may not be INTRINSIC
+ !PORTABILITY: Specific procedure 'cos' of generic interface 'xintercept' should not be INTRINSIC
intrinsic cos
generic :: xIntercept => cos
end module
More information about the flang-commits
mailing list