[flang-commits] [flang] [flang][lowering] handle procedure pointers with generic name (PR #108043)
via flang-commits
flang-commits at lists.llvm.org
Tue Sep 10 08:23:38 PDT 2024
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-semantics
Author: None (jeanPerier)
<details>
<summary>Changes</summary>
Handle procedure pointer with the same name as generics in lowering to avoid crashes after #<!-- -->107928 (first commit is cherry-picked from that PR).
---
Full diff: https://github.com/llvm/llvm-project/pull/108043.diff
8 Files Affected:
- (modified) flang/include/flang/Semantics/scope.h (+2)
- (modified) flang/lib/Lower/PFTBuilder.cpp (+8-1)
- (modified) flang/lib/Semantics/compute-offsets.cpp (+7)
- (modified) flang/lib/Semantics/expression.cpp (+6-1)
- (modified) flang/lib/Semantics/resolve-names.cpp (+58-11)
- (modified) flang/lib/Semantics/symbol.cpp (+2-1)
- (added) flang/test/Lower/HLFIR/procedure-pointer-in-generics.f90 (+46)
- (added) flang/test/Semantics/generic10.f90 (+17)
``````````diff
diff --git a/flang/include/flang/Semantics/scope.h b/flang/include/flang/Semantics/scope.h
index a58163f5460c25..e73a507e9b3f5b 100644
--- a/flang/include/flang/Semantics/scope.h
+++ b/flang/include/flang/Semantics/scope.h
@@ -138,6 +138,8 @@ class Scope {
const_iterator cend() const { return symbols_.cend(); }
// Return symbols in declaration order (the iterators above are in name order)
+ // When a generic procedure interface shadows a derived type or specific
+ // procedure, only the generic's symbol appears in the output.
SymbolVector GetSymbols() const;
MutableSymbolVector GetSymbols();
diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp
index 5b3d5471925bff..845c007d5e5f77 100644
--- a/flang/lib/Lower/PFTBuilder.cpp
+++ b/flang/lib/Lower/PFTBuilder.cpp
@@ -1566,6 +1566,14 @@ struct SymbolDependenceAnalysis {
return 0;
LLVM_DEBUG(llvm::dbgs() << "analyze symbol " << &sym << " in <"
<< &sym.owner() << ">: " << sym << '\n');
+ semantics::Symbol ultimate = sym.GetUltimate();
+ if (const auto *details = ultimate.detailsIf<semantics::GenericDetails>()) {
+ // Procedure pointers may be "hidden" behind to the generic symbol if they
+ // have the same name.
+ if (const semantics::Symbol *specific{details->specific()})
+ analyze(*specific);
+ return 0;
+ }
const bool isProcedurePointerOrDummy =
semantics::IsProcedurePointer(sym) ||
(semantics::IsProcedure(sym) && IsDummy(sym));
@@ -1582,7 +1590,6 @@ struct SymbolDependenceAnalysis {
if (sym.owner().IsDerivedType())
return 0;
- semantics::Symbol ultimate = sym.GetUltimate();
if (const auto *details =
ultimate.detailsIf<semantics::NamelistDetails>()) {
// handle namelist group symbols
diff --git a/flang/lib/Semantics/compute-offsets.cpp b/flang/lib/Semantics/compute-offsets.cpp
index d9a9576e9d676a..b5a58ddca0ecdd 100644
--- a/flang/lib/Semantics/compute-offsets.cpp
+++ b/flang/lib/Semantics/compute-offsets.cpp
@@ -114,6 +114,13 @@ void ComputeOffsetsHelper::Compute(Scope &scope) {
dependents_.find(symbol) == dependents_.end() &&
equivalenceBlock_.find(symbol) == equivalenceBlock_.end()) {
DoSymbol(*symbol);
+ if (auto *generic{symbol->detailsIf<GenericDetails>()}) {
+ if (Symbol * specific{generic->specific()};
+ specific && !FindCommonBlockContaining(*specific)) {
+ // might be a shadowed procedure pointer
+ DoSymbol(*specific);
+ }
+ }
}
}
// Ensure that the size is a multiple of the alignment
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 3684839c187e68..5e4174a557af65 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -210,7 +210,8 @@ class ArgumentAnalyzer {
// or procedure pointer reference in a ProcedureDesignator.
MaybeExpr ExpressionAnalyzer::Designate(DataRef &&ref) {
const Symbol &last{ref.GetLastSymbol()};
- const Symbol &symbol{BypassGeneric(last).GetUltimate()};
+ const Symbol &specific{BypassGeneric(last)};
+ const Symbol &symbol{specific.GetUltimate()};
if (semantics::IsProcedure(symbol)) {
if (symbol.attrs().test(semantics::Attr::ABSTRACT)) {
Say("Abstract procedure interface '%s' may not be used as a designator"_err_en_US,
@@ -226,6 +227,10 @@ MaybeExpr ExpressionAnalyzer::Designate(DataRef &&ref) {
} else if (!symbol.attrs().test(semantics::Attr::INTRINSIC)) {
if (symbol.has<semantics::GenericDetails>()) {
Say("'%s' is not a specific procedure"_err_en_US, last.name());
+ } else if (IsProcedurePointer(specific)) {
+ // For procedure pointers, retain associations so that data accesses
+ // from client modules will work.
+ return Expr<SomeType>{ProcedureDesignator{specific}};
} else {
return Expr<SomeType>{ProcedureDesignator{symbol}};
}
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 2e86e0afc9bd0e..a2bdeb39901553 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -618,6 +618,20 @@ class ScopeHandler : public ImplicitRulesVisitor {
return *derivedType;
}
}
+ } else if constexpr (std::is_same_v<ProcEntityDetails, D>) {
+ if (auto *d{symbol->detailsIf<GenericDetails>()}) {
+ if (!d->derivedType()) {
+ // procedure pointer with same name as a generic
+ auto *specific{d->specific()};
+ if (!specific) {
+ specific = &currScope().MakeSymbol(name, attrs, std::move(details));
+ d->set_specific(*specific);
+ } else {
+ SayAlreadyDeclared(name, *specific);
+ }
+ return *specific;
+ }
+ }
}
if (symbol->CanReplaceDetails(details)) {
// update the existing symbol
@@ -3035,14 +3049,26 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
return;
}
const Symbol &useUltimate{useSymbol.GetUltimate()};
+ const auto *useGeneric{useUltimate.detailsIf<GenericDetails>()};
if (localSymbol->has<UnknownDetails>()) {
- localSymbol->set_details(UseDetails{localName, useSymbol});
- localSymbol->attrs() =
- useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE, Attr::SAVE};
- localSymbol->implicitAttrs() =
- localSymbol->attrs() & Attrs{Attr::ASYNCHRONOUS, Attr::VOLATILE};
- localSymbol->flags() = useSymbol.flags();
- return;
+ if (useGeneric && useGeneric->specific() &&
+ IsProcedurePointer(*useGeneric->specific())) {
+ // We are use-associating a generic that shadows a procedure pointer.
+ // Local references that might be made to that procedure pointer should
+ // use a UseDetails symbol for proper data addressing. So create an
+ // empty local generic now into which the use-associated generic may
+ // be copied.
+ localSymbol->set_details(GenericDetails{});
+ localSymbol->get<GenericDetails>().set_kind(useGeneric->kind());
+ } else { // just create UseDetails
+ localSymbol->set_details(UseDetails{localName, useSymbol});
+ localSymbol->attrs() =
+ useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE, Attr::SAVE};
+ localSymbol->implicitAttrs() =
+ localSymbol->attrs() & Attrs{Attr::ASYNCHRONOUS, Attr::VOLATILE};
+ localSymbol->flags() = useSymbol.flags();
+ return;
+ }
}
Symbol &localUltimate{localSymbol->GetUltimate()};
@@ -3066,10 +3092,7 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
// - anything other than a derived type, non-generic procedure, or
// generic procedure being combined with something other than an
// prior USE association of itself
-
auto *localGeneric{localUltimate.detailsIf<GenericDetails>()};
- const auto *useGeneric{useUltimate.detailsIf<GenericDetails>()};
-
Symbol *localDerivedType{nullptr};
if (localUltimate.has<DerivedTypeDetails>()) {
localDerivedType = &localUltimate;
@@ -3261,6 +3284,15 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
// At this point, there must be at least one generic interface.
CHECK(localGeneric || (useGeneric && (localDerivedType || localProcedure)));
+ // Ensure that a use-associated specific procedure that is a procedure
+ // pointer is properly represented as a USE association of an entity.
+ if (IsProcedurePointer(useProcedure)) {
+ Symbol &combined{currScope().MakeSymbol(localSymbol->name(),
+ useProcedure->attrs(), UseDetails{localName, *useProcedure})};
+ combined.flags() |= useProcedure->flags();
+ combinedProcedure = &combined;
+ }
+
if (localGeneric) {
// Create a local copy of a previously use-associated generic so that
// it can be locally extended without corrupting the original.
@@ -5079,7 +5111,22 @@ bool DeclarationVisitor::HasCycle(
Symbol &DeclarationVisitor::DeclareProcEntity(
const parser::Name &name, Attrs attrs, const Symbol *interface) {
- Symbol &symbol{DeclareEntity<ProcEntityDetails>(name, attrs)};
+ Symbol *proc{nullptr};
+ if (auto *extant{FindInScope(name)}) {
+ if (auto *d{extant->detailsIf<GenericDetails>()}; d && !d->derivedType()) {
+ // procedure pointer with same name as a generic
+ if (auto *specific{d->specific()}) {
+ SayAlreadyDeclared(name, *specific);
+ } else {
+ // Create the ProcEntityDetails symbol in the scope as the "specific()"
+ // symbol behind an existing GenericDetails symbol of the same name.
+ proc = &Resolve(name,
+ currScope().MakeSymbol(name.source, attrs, ProcEntityDetails{}));
+ d->set_specific(*proc);
+ }
+ }
+ }
+ Symbol &symbol{proc ? *proc : DeclareEntity<ProcEntityDetails>(name, attrs)};
if (auto *details{symbol.detailsIf<ProcEntityDetails>()}) {
if (context().HasError(symbol)) {
} else if (HasCycle(symbol, interface)) {
diff --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp
index b593bf89b18bc9..14d6564664f2cc 100644
--- a/flang/lib/Semantics/symbol.cpp
+++ b/flang/lib/Semantics/symbol.cpp
@@ -210,8 +210,9 @@ const Symbol *GenericDetails::CheckSpecific() const {
}
Symbol *GenericDetails::CheckSpecific() {
if (specific_ && !specific_->has<UseErrorDetails>()) {
+ const Symbol &ultimate{specific_->GetUltimate()};
for (const Symbol &proc : specificProcs_) {
- if (&proc == specific_) {
+ if (&proc.GetUltimate() == &ultimate) {
return nullptr;
}
}
diff --git a/flang/test/Lower/HLFIR/procedure-pointer-in-generics.f90 b/flang/test/Lower/HLFIR/procedure-pointer-in-generics.f90
new file mode 100644
index 00000000000000..ff447d31b1af1c
--- /dev/null
+++ b/flang/test/Lower/HLFIR/procedure-pointer-in-generics.f90
@@ -0,0 +1,46 @@
+! Test procedure pointers with the same name as generics.
+! RUN: bbc -emit-hlfir -o - %s | FileCheck %s
+
+module m_gen
+ procedure(func), pointer :: foo
+ interface foo
+ procedure :: foo
+ end interface
+ interface
+ real function func(x)
+ real :: x
+ end function
+ end interface
+end
+!CHECK-LABEL: fir.global @_QMm_genEfoo : !fir.boxproc<(!fir.ref<f32>) -> f32> {
+!CHECK: %[[VAL_0:.*]] = fir.zero_bits (!fir.ref<f32>) -> f32
+!CHECK: %[[VAL_1:.*]] = fir.emboxproc %[[VAL_0]] : ((!fir.ref<f32>) -> f32) -> !fir.boxproc<(!fir.ref<f32>) -> f32>
+!CHECK: fir.has_value %[[VAL_1]] : !fir.boxproc<(!fir.ref<f32>) -> f32>
+
+subroutine test1()
+ use m_gen
+ foo => func
+end subroutine
+!CHECK-LABEL: func.func @_QPtest1() {
+!CHECK: %[[VAL_0:.*]] = fir.address_of(@_QMm_genEfoo) : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
+!CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {{.*}}"_QMm_genEfoo"{{.*}} : (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>) -> (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>, !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>)
+!CHECK: %[[VAL_2:.*]] = fir.address_of(@_QPfunc) : (!fir.ref<f32>) -> f32
+!CHECK: %[[VAL_3:.*]] = fir.emboxproc %[[VAL_2]] : ((!fir.ref<f32>) -> f32) -> !fir.boxproc<() -> ()>
+!CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref<f32>) -> f32>
+!CHECK: fir.store %[[VAL_4]] to %[[VAL_1]]#0 : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
+
+subroutine test_local()
+ use m_gen, only : func
+ procedure(func), pointer :: foo
+ interface foo
+ procedure :: foo
+ end interface
+ foo => func
+end subroutine
+!CHECK-LABEL: func.func @_QPtest_local() {
+!CHECK: %[[VAL_0:.*]] = fir.alloca !fir.boxproc<(!fir.ref<f32>) -> f32> {bindc_name = "foo", uniq_name = "_QFtest_localEfoo"}
+!CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {{.*}}"_QFtest_localEfoo"{{.*}} : (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>) -> (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>, !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>)
+!CHECK: %[[VAL_4:.*]] = fir.address_of(@_QPfunc) : (!fir.ref<f32>) -> f32
+!CHECK: %[[VAL_5:.*]] = fir.emboxproc %[[VAL_4]] : ((!fir.ref<f32>) -> f32) -> !fir.boxproc<() -> ()>
+!CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref<f32>) -> f32>
+!CHECK: fir.store %[[VAL_6]] to %[[VAL_3]]#0 : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
diff --git a/flang/test/Semantics/generic10.f90 b/flang/test/Semantics/generic10.f90
new file mode 100644
index 00000000000000..203d0bb855208d
--- /dev/null
+++ b/flang/test/Semantics/generic10.f90
@@ -0,0 +1,17 @@
+! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+module m
+ procedure(func), pointer :: foo
+ interface foo
+ procedure :: foo
+ end interface
+ contains
+ function func(x)
+ func = x
+ end
+end
+
+program main
+ use m
+!CHECK: foo => func
+ foo => func
+end
``````````
</details>
https://github.com/llvm/llvm-project/pull/108043
More information about the flang-commits
mailing list