[flang-commits] [flang] [flang] USE-associated explicit INTRINSIC names (PR #76199)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Tue Dec 26 12:09:43 PST 2023
https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/76199
>From ca3d6f95034232c388e1f48c8035cefeef7284b9 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Thu, 21 Dec 2023 16:45:37 -0800
Subject: [PATCH] [flang] USE-associated explicit INTRINSIC names
The compiler doesn't USE-associate the names of intrinsic procedures
from modules (in the absence of ONLY:), so that the associating
scope doesn't get populated with names of intrinsics that were used
only in declarations (e.g., SELECTED_REAL_KIND). A recent bug report
(below) shows that we should modify that policy in the case of names
that appear in explicit INTRINSIC attribute statements. The behaviors
of other Fortran compilers are not consistent and the requirements of the
standard are not clear; this fix follows the precedent set by gfortran
and nvfortran.
Fixes https://github.com/llvm/llvm-project/issues/72084.
---
flang/docs/Extensions.md | 4 ++
flang/lib/Semantics/resolve-names.cpp | 59 +++++++++++++++++----------
flang/test/Semantics/contiguous01.f90 | 2 +-
flang/test/Semantics/intrinsics02.f90 | 38 +++++++++++++++++
4 files changed, 80 insertions(+), 23 deletions(-)
create mode 100644 flang/test/Semantics/intrinsics02.f90
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 03d4310466485c..6c6588025a392d 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -641,6 +641,10 @@ module m
end
```
+* When an intrinsic procedure appears in the specification part of a module
+ only in function references, but not an explicit `INTRINSIC` statement,
+ its name is not brought into other scopes by a `USE` statement.
+
## De Facto Standard Features
* `EXTENDS_TYPE_OF()` returns `.TRUE.` if both of its arguments have the
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index e1cd34ddf65b6b..f5f7b99aba2551 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -2904,7 +2904,7 @@ void ModuleVisitor::Post(const parser::UseStmt &x) {
}
for (const auto &[name, symbol] : *useModuleScope_) {
if (symbol->attrs().test(Attr::PUBLIC) && !IsUseRenamed(symbol->name()) &&
- (!symbol->attrs().test(Attr::INTRINSIC) ||
+ (!symbol->implicitAttrs().test(Attr::INTRINSIC) ||
symbol->has<UseDetails>()) &&
!symbol->has<MiscDetails>() && useNames.count(name) == 0) {
SourceName location{x.moduleName.source};
@@ -2998,7 +2998,7 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
details->add_occurrence(location, *useModuleScope_);
return;
}
-
+ const Symbol &useUltimate{useSymbol.GetUltimate()};
if (localSymbol.has<UnknownDetails>()) {
localSymbol.set_details(UseDetails{localName, useSymbol});
localSymbol.attrs() =
@@ -3010,7 +3010,6 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
}
Symbol &localUltimate{localSymbol.GetUltimate()};
- const Symbol &useUltimate{useSymbol.GetUltimate()};
if (&localUltimate == &useUltimate) {
// use-associating the same symbol again -- ok
return;
@@ -3044,13 +3043,19 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
checkAmbiguousDerivedType(&useUltimate, localGeneric->derivedType());
} else if (&useUltimate == &BypassGeneric(localUltimate).GetUltimate()) {
return; // nothing to do; used subprogram is local's specific
+ } else if (useUltimate.attrs().test(Attr::INTRINSIC) &&
+ useUltimate.name() == localSymbol.name()) {
+ return; // local generic can extend intrinsic
}
} else if (useGeneric) {
if (localUltimate.has<DerivedTypeDetails>()) {
combine =
checkAmbiguousDerivedType(&localUltimate, useGeneric->derivedType());
- } else if (&localUltimate == &BypassGeneric(useUltimate).GetUltimate()) {
- // Local is the specific of the used generic; replace it.
+ } else if (&localUltimate == &BypassGeneric(useUltimate).GetUltimate() ||
+ (localSymbol.attrs().test(Attr::INTRINSIC) &&
+ localUltimate.name() == useUltimate.name())) {
+ // Local is the specific of the used generic or an intrinsic with the
+ // same name; replace it.
EraseSymbol(localSymbol);
Symbol &newSymbol{MakeSymbol(localName,
useUltimate.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE},
@@ -3058,23 +3063,22 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
newSymbol.flags() = useSymbol.flags();
return;
}
+ } else if (localUltimate.name() != useUltimate.name()) {
+ // not the same procedure
+ } else if (localUltimate.attrs().test(Attr::INTRINSIC) &&
+ useUltimate.attrs().test(Attr::INTRINSIC)) {
+ return;
} else {
auto localClass{ClassifyProcedure(localUltimate)};
auto useClass{ClassifyProcedure(useUltimate)};
- if (localClass == useClass &&
- (localClass == ProcedureDefinitionClass::Intrinsic ||
- localClass == ProcedureDefinitionClass::External) &&
- localUltimate.name() == useUltimate.name()) {
+ if (localClass == ProcedureDefinitionClass::External &&
+ useClass == ProcedureDefinitionClass::External) {
auto localChars{evaluate::characteristics::Procedure::Characterize(
localUltimate, GetFoldingContext())};
auto useChars{evaluate::characteristics::Procedure::Characterize(
useUltimate, GetFoldingContext())};
- if (localChars && useChars) {
- if (*localChars == *useChars) {
- // Same intrinsic or external procedure defined identically in two
- // modules
- return;
- }
+ if (localChars && useChars && *localChars == *useChars) {
+ return; // same procedure defined identically in two modules
}
}
}
@@ -4794,9 +4798,15 @@ Symbol &DeclarationVisitor::HandleAttributeStmt(
}
}
} else if (symbol && symbol->has<UseDetails>()) {
- Say(currStmtSource().value(),
- "Cannot change %s attribute on use-associated '%s'"_err_en_US,
- EnumToString(attr), name.source);
+ if (symbol->GetUltimate().attrs().test(attr)) {
+ Say(currStmtSource().value(),
+ "Use-associated '%s' already has '%s' attribute"_warn_en_US,
+ name.source, EnumToString(attr));
+ } else {
+ Say(currStmtSource().value(),
+ "Cannot change %s attribute on use-associated '%s'"_err_en_US,
+ EnumToString(attr), name.source);
+ }
return *symbol;
}
if (!symbol) {
@@ -6244,8 +6254,8 @@ bool DeclarationVisitor::HandleUnrestrictedSpecificIntrinsicFunction(
// recreated for it later on demand, but capturing its result type here
// will make GetType() return a correct result without having to
// probe the intrinsics table again.
- Symbol &symbol{
- MakeSymbol(InclusiveScope(), name.source, Attrs{Attr::INTRINSIC})};
+ Symbol &symbol{MakeSymbol(InclusiveScope(), name.source, Attrs{})};
+ SetImplicitAttr(symbol, Attr::INTRINSIC);
CHECK(interface->functionResult.has_value());
evaluate::DynamicType dyType{
DEREF(interface->functionResult->GetTypeAndShape()).type()};
@@ -7708,8 +7718,8 @@ void ResolveNamesVisitor::HandleProcedureName(
auto *symbol{FindSymbol(NonDerivedTypeScope(), name)};
if (!symbol) {
if (IsIntrinsic(name.source, flag)) {
- symbol =
- &MakeSymbol(InclusiveScope(), name.source, Attrs{Attr::INTRINSIC});
+ symbol = &MakeSymbol(InclusiveScope(), name.source, Attrs{});
+ SetImplicitAttr(*symbol, Attr::INTRINSIC);
} else if (const auto ppcBuiltinScope =
currScope().context().GetPPCBuiltinsScope()) {
// Check if it is a builtin from the predefined module
@@ -8047,6 +8057,11 @@ void ResolveNamesVisitor::CreateGeneric(const parser::GenericSpec &x) {
} else if (ultimate.has<SubprogramDetails>() ||
ultimate.has<SubprogramNameDetails>()) {
genericDetails.set_specific(*existing);
+ } else if (ultimate.has<ProcEntityDetails>()) {
+ if (existing->name() != symbolName ||
+ !ultimate.attrs().test(Attr::INTRINSIC)) {
+ genericDetails.set_specific(*existing);
+ }
} else if (ultimate.has<DerivedTypeDetails>()) {
genericDetails.set_derivedType(*existing);
} else if (&existing->owner() == &currScope()) {
diff --git a/flang/test/Semantics/contiguous01.f90 b/flang/test/Semantics/contiguous01.f90
index 1d3600aef6c555..0f086624a20ae0 100644
--- a/flang/test/Semantics/contiguous01.f90
+++ b/flang/test/Semantics/contiguous01.f90
@@ -5,7 +5,7 @@ module m0
end
module m
use m0
- !ERROR: Cannot change CONTIGUOUS attribute on use-associated 'p1'
+ !WARNING: Use-associated 'p1' already has 'CONTIGUOUS' attribute
contiguous p1
!ERROR: Cannot change CONTIGUOUS attribute on use-associated 'p2'
contiguous p2
diff --git a/flang/test/Semantics/intrinsics02.f90 b/flang/test/Semantics/intrinsics02.f90
new file mode 100644
index 00000000000000..0b1f7c13a15643
--- /dev/null
+++ b/flang/test/Semantics/intrinsics02.f90
@@ -0,0 +1,38 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+module explicit
+ intrinsic cos
+end
+subroutine testExplicit
+ use explicit
+ !ERROR: 'cos' is use-associated from module 'explicit' and cannot be re-declared
+ real :: cos = 2.
+end
+subroutine extendsUsedIntrinsic
+ use explicit
+ interface cos
+ pure real function mycos(x)
+ real, intent(in) :: x
+ end
+ end interface
+end
+subroutine sameIntrinsic1
+ use explicit
+ !WARNING: Use-associated 'cos' already has 'INTRINSIC' attribute
+ intrinsic cos
+ real :: one = cos(0.)
+end
+module renamer
+ use explicit, renamedCos => cos
+end
+subroutine sameIntrinsic2
+ use explicit
+ use renamer, cos => renamedCos
+ real :: one = cos(0.)
+end
+module implicit
+ real :: one = cos(0.)
+end
+subroutine testImplicit
+ use implicit
+ real :: cos = 2.
+end
More information about the flang-commits
mailing list