[flang-commits] [flang] 5a402c5 - [flang] USE-associated explicit INTRINSIC names (#76199)
via flang-commits
flang-commits at lists.llvm.org
Tue Dec 26 16:03:06 PST 2023
Author: Peter Klausler
Date: 2023-12-26T16:03:03-08:00
New Revision: 5a402c56226e9b50bffdedd19d2acb8b61b408a3
URL: https://github.com/llvm/llvm-project/commit/5a402c56226e9b50bffdedd19d2acb8b61b408a3
DIFF: https://github.com/llvm/llvm-project/commit/5a402c56226e9b50bffdedd19d2acb8b61b408a3.diff
LOG: [flang] USE-associated explicit INTRINSIC names (#76199)
The compiler doesn't USE-associate 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.
Added:
flang/test/Semantics/intrinsics02.f90
Modified:
flang/docs/Extensions.md
flang/lib/Semantics/resolve-names.cpp
flang/module/iso_fortran_env.f90
flang/test/Semantics/contiguous01.f90
Removed:
################################################################################
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/module/iso_fortran_env.f90 b/flang/module/iso_fortran_env.f90
index f1d540bc8e4519..61d8a07e611338 100644
--- a/flang/module/iso_fortran_env.f90
+++ b/flang/module/iso_fortran_env.f90
@@ -23,6 +23,7 @@ module iso_fortran_env
compiler_version => __builtin_compiler_version
implicit none
+ private count
! TODO: Use PACK([x],test) in place of the array constructor idiom
! [(x, integer::j=1,COUNT([test]))] below once PACK() can be folded.
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