Skip to content

Commit 3dc314b

Browse files
luporlluporl
authored
[flang] Fix lowering of unused dummy procedure pointers (llvm#155649)
Fixes llvm#126453
1 parent a80c393 commit 3dc314b

File tree

4 files changed

+89
-9
lines changed

4 files changed

+89
-9
lines changed

‎flang/include/flang/Lower/CallInterface.h‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -478,6 +478,12 @@ getOrDeclareFunction(const Fortran::evaluate::ProcedureDesignator &,
478478
mlir::Type getDummyProcedureType(const Fortran::semantics::Symbol &dummyProc,
479479
Fortran::lower::AbstractConverter &);
480480

481+
/// Return the type of an argument that is a dummy procedure pointer. This
482+
/// will be a reference to a boxed procedure.
483+
mlir::Type
484+
getDummyProcedurePointerType(const Fortran::semantics::Symbol &dummyProcPtr,
485+
Fortran::lower::AbstractConverter &);
486+
481487
/// Return !fir.boxproc<() -> ()> type.
482488
mlir::Type getUntypedBoxProcType(mlir::MLIRContext *context);
483489

‎flang/lib/Lower/CallInterface.cpp‎

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1766,6 +1766,17 @@ mlir::Type Fortran::lower::getDummyProcedureType(
17661766
return procType;
17671767
}
17681768

1769+
mlir::Type Fortran::lower::getDummyProcedurePointerType(
1770+
const Fortran::semantics::Symbol &dummyProcPtr,
1771+
Fortran::lower::AbstractConverter &converter) {
1772+
std::optional<Fortran::evaluate::characteristics::Procedure> iface =
1773+
Fortran::evaluate::characteristics::Procedure::Characterize(
1774+
dummyProcPtr, converter.getFoldingContext());
1775+
mlir::Type procPtrType = getProcedureDesignatorType(
1776+
iface.has_value() ? &*iface : nullptr, converter);
1777+
return fir::ReferenceType::get(procPtrType);
1778+
}
1779+
17691780
bool Fortran::lower::isCPtrArgByValueType(mlir::Type ty) {
17701781
return mlir::isa<fir::ReferenceType>(ty) &&
17711782
fir::isa_integer(fir::unwrapRefType(ty));

‎flang/lib/Lower/ConvertVariable.cpp‎

Lines changed: 13 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -2159,15 +2159,19 @@ void Fortran::lower::mapSymbolAttributes(
21592159
if (Fortran::semantics::IsProcedure(sym)) {
21602160
if (isUnusedEntryDummy) {
21612161
// Additional discussion below.
2162-
mlir::Type dummyProcType =
2163-
Fortran::lower::getDummyProcedureType(sym, converter);
2164-
mlir::Value undefOp = fir::UndefOp::create(builder, loc, dummyProcType);
2165-
2166-
Fortran::lower::genDeclareSymbol(converter, symMap, sym, undefOp);
2167-
}
2168-
2169-
// Procedure pointer.
2170-
if (Fortran::semantics::IsPointer(sym)) {
2162+
if (Fortran::semantics::IsPointer(sym)) {
2163+
mlir::Type procPtrType =
2164+
Fortran::lower::getDummyProcedurePointerType(sym, converter);
2165+
mlir::Value undefOp = fir::UndefOp::create(builder, loc, procPtrType);
2166+
genProcPointer(converter, symMap, sym, undefOp, replace);
2167+
} else {
2168+
mlir::Type dummyProcType =
2169+
Fortran::lower::getDummyProcedureType(sym, converter);
2170+
mlir::Value undefOp = fir::UndefOp::create(builder, loc, dummyProcType);
2171+
Fortran::lower::genDeclareSymbol(converter, symMap, sym, undefOp);
2172+
}
2173+
} else if (Fortran::semantics::IsPointer(sym)) {
2174+
// Used procedure pointer.
21712175
// global
21722176
mlir::Value boxAlloc = preAlloc;
21732177
// dummy or passed result

‎flang/test/Lower/HLFIR/dummy-proc-ptr-in-entry.f90‎

Lines changed: 59 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,59 @@
1+
! Test dummy procedure pointers that are not an argument in every entry.
2+
! This requires creating a mock value in the entries where it is not an
3+
! argument.
4+
!
5+
!RUN: %flang_fc1 -emit-hlfir %s -o - 2>&1 | FileCheck %s
6+
7+
!CHECK-LABEL: func @_QPdummy_char_proc_ptr() -> !fir.boxproc<(!fir.ref<!fir.char<1>>, index) -> !fir.boxchar<1>> {
8+
!CHECK: %[[UNDEF:.*]] = fir.undefined !fir.ref<!fir.boxproc<() -> ()>>
9+
!CHECK: %{{.*}}:2 = hlfir.declare %[[UNDEF]]
10+
!CHECK-SAME: {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFdummy_char_proc_ptrEdummy"}
11+
!CHECK-SAME: : (!fir.ref<!fir.boxproc<() -> ()>>)
12+
!CHECK-SAME: -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)
13+
14+
!CHECK-LABEL: func @_QPdummy_char_proc_ptr_entry(
15+
!CHECK-SAME: %[[ARG:.*]]: !fir.ref<!fir.boxproc<() -> ()>>)
16+
!CHECK-SAME: -> !fir.boxproc<(!fir.ref<!fir.char<1>>, index) -> !fir.boxchar<1>> {
17+
!CHECK: %{{.*}}:2 = hlfir.declare %[[ARG]] dummy_scope %{{[^ ]*}}
18+
!CHECK-SAME: {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFdummy_char_proc_ptrEdummy"}
19+
!CHECK-SAME: : (!fir.ref<!fir.boxproc<() -> ()>>, !fir.dscope)
20+
!CHECK-SAME: -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)
21+
function dummy_char_proc_ptr() result(fun)
22+
interface
23+
character function char_fun()
24+
end function
25+
end interface
26+
27+
procedure (char_fun), pointer :: fun, dummy_char_proc_ptr_entry, dummy
28+
fun => null()
29+
return
30+
31+
entry dummy_char_proc_ptr_entry(dummy)
32+
end function
33+
34+
!CHECK-LABEL: func @_QPdummy_int_proc_ptr()
35+
!CHECK: %[[UNDEF:.*]] = fir.undefined !fir.ref<!fir.boxproc<() -> ()>>
36+
!CHECK: %{{.*}}:2 = hlfir.declare %[[UNDEF]]
37+
!CHECK-SAME: {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFdummy_int_proc_ptrEdummy"}
38+
!CHECK-SAME: : (!fir.ref<!fir.boxproc<() -> ()>>)
39+
!CHECK-SAME: -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)
40+
41+
!CHECK-LABEL: func @_QPdummy_int_proc_ptr_entry(
42+
!CHECK-SAME: %[[ARG:.*]]: !fir.ref<!fir.boxproc<() -> ()>>)
43+
!CHECK-SAME: -> !fir.boxproc<() -> i32> {
44+
!CHECK: %{{.*}}:2 = hlfir.declare %[[ARG]] dummy_scope %{{[^ ]*}}
45+
!CHECK-SAME: {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFdummy_int_proc_ptrEdummy"}
46+
!CHECK-SAME: : (!fir.ref<!fir.boxproc<() -> ()>>, !fir.dscope)
47+
!CHECK-SAME: -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)
48+
function dummy_int_proc_ptr() result(fun)
49+
interface
50+
integer function int_fun()
51+
end function
52+
end interface
53+
54+
procedure (int_fun), pointer :: fun, dummy_int_proc_ptr_entry, dummy
55+
fun => null()
56+
return
57+
58+
entry dummy_int_proc_ptr_entry(dummy)
59+
end function

0 commit comments

Comments
 (0)