diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h index 72bc9dd890a94..926a42756c6ef 100644 --- a/flang/include/flang/Lower/CallInterface.h +++ b/flang/include/flang/Lower/CallInterface.h @@ -478,6 +478,12 @@ getOrDeclareFunction(const Fortran::evaluate::ProcedureDesignator &, mlir::Type getDummyProcedureType(const Fortran::semantics::Symbol &dummyProc, Fortran::lower::AbstractConverter &); +/// Return the type of an argument that is a dummy procedure pointer. This +/// will be a reference to a boxed procedure. +mlir::Type +getDummyProcedurePointerType(const Fortran::semantics::Symbol &dummyProcPtr, + Fortran::lower::AbstractConverter &); + /// Return !fir.boxproc<() -> ()> type. mlir::Type getUntypedBoxProcType(mlir::MLIRContext *context); diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp index 72431a9cfacc4..c3284cd936f8f 100644 --- a/flang/lib/Lower/CallInterface.cpp +++ b/flang/lib/Lower/CallInterface.cpp @@ -1766,6 +1766,17 @@ mlir::Type Fortran::lower::getDummyProcedureType( return procType; } +mlir::Type Fortran::lower::getDummyProcedurePointerType( + const Fortran::semantics::Symbol &dummyProcPtr, + Fortran::lower::AbstractConverter &converter) { + std::optional iface = + Fortran::evaluate::characteristics::Procedure::Characterize( + dummyProcPtr, converter.getFoldingContext()); + mlir::Type procPtrType = getProcedureDesignatorType( + iface.has_value() ? &*iface : nullptr, converter); + return fir::ReferenceType::get(procPtrType); +} + bool Fortran::lower::isCPtrArgByValueType(mlir::Type ty) { return mlir::isa(ty) && fir::isa_integer(fir::unwrapRefType(ty)); diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp index fd66592bc285b..d43ed8f347b85 100644 --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -2149,15 +2149,19 @@ void Fortran::lower::mapSymbolAttributes( if (Fortran::semantics::IsProcedure(sym)) { if (isUnusedEntryDummy) { // Additional discussion below. - mlir::Type dummyProcType = - Fortran::lower::getDummyProcedureType(sym, converter); - mlir::Value undefOp = fir::UndefOp::create(builder, loc, dummyProcType); - - Fortran::lower::genDeclareSymbol(converter, symMap, sym, undefOp); - } - - // Procedure pointer. - if (Fortran::semantics::IsPointer(sym)) { + if (Fortran::semantics::IsPointer(sym)) { + mlir::Type procPtrType = + Fortran::lower::getDummyProcedurePointerType(sym, converter); + mlir::Value undefOp = fir::UndefOp::create(builder, loc, procPtrType); + genProcPointer(converter, symMap, sym, undefOp, replace); + } else { + mlir::Type dummyProcType = + Fortran::lower::getDummyProcedureType(sym, converter); + mlir::Value undefOp = fir::UndefOp::create(builder, loc, dummyProcType); + Fortran::lower::genDeclareSymbol(converter, symMap, sym, undefOp); + } + } else if (Fortran::semantics::IsPointer(sym)) { + // Used procedure pointer. // global mlir::Value boxAlloc = preAlloc; // dummy or passed result diff --git a/flang/test/Lower/HLFIR/dummy-proc-ptr-in-entry.f90 b/flang/test/Lower/HLFIR/dummy-proc-ptr-in-entry.f90 new file mode 100644 index 0000000000000..280268112d5a0 --- /dev/null +++ b/flang/test/Lower/HLFIR/dummy-proc-ptr-in-entry.f90 @@ -0,0 +1,59 @@ +! Test dummy procedure pointers that are not an argument in every entry. +! This requires creating a mock value in the entries where it is not an +! argument. +! +!RUN: %flang_fc1 -emit-hlfir %s -o - 2>&1 | FileCheck %s + +!CHECK-LABEL: func @_QPdummy_char_proc_ptr() -> !fir.boxproc<(!fir.ref>, index) -> !fir.boxchar<1>> { +!CHECK: %[[UNDEF:.*]] = fir.undefined !fir.ref ()>> +!CHECK: %{{.*}}:2 = hlfir.declare %[[UNDEF]] +!CHECK-SAME: {fortran_attrs = #fir.var_attrs, uniq_name = "_QFdummy_char_proc_ptrEdummy"} +!CHECK-SAME: : (!fir.ref ()>>) +!CHECK-SAME: -> (!fir.ref ()>>, !fir.ref ()>>) + +!CHECK-LABEL: func @_QPdummy_char_proc_ptr_entry( +!CHECK-SAME: %[[ARG:.*]]: !fir.ref ()>>) +!CHECK-SAME: -> !fir.boxproc<(!fir.ref>, index) -> !fir.boxchar<1>> { +!CHECK: %{{.*}}:2 = hlfir.declare %[[ARG]] dummy_scope %{{[^ ]*}} +!CHECK-SAME: {fortran_attrs = #fir.var_attrs, uniq_name = "_QFdummy_char_proc_ptrEdummy"} +!CHECK-SAME: : (!fir.ref ()>>, !fir.dscope) +!CHECK-SAME: -> (!fir.ref ()>>, !fir.ref ()>>) +function dummy_char_proc_ptr() result(fun) + interface + character function char_fun() + end function + end interface + + procedure (char_fun), pointer :: fun, dummy_char_proc_ptr_entry, dummy + fun => null() + return + + entry dummy_char_proc_ptr_entry(dummy) +end function + +!CHECK-LABEL: func @_QPdummy_int_proc_ptr() +!CHECK: %[[UNDEF:.*]] = fir.undefined !fir.ref ()>> +!CHECK: %{{.*}}:2 = hlfir.declare %[[UNDEF]] +!CHECK-SAME: {fortran_attrs = #fir.var_attrs, uniq_name = "_QFdummy_int_proc_ptrEdummy"} +!CHECK-SAME: : (!fir.ref ()>>) +!CHECK-SAME: -> (!fir.ref ()>>, !fir.ref ()>>) + +!CHECK-LABEL: func @_QPdummy_int_proc_ptr_entry( +!CHECK-SAME: %[[ARG:.*]]: !fir.ref ()>>) +!CHECK-SAME: -> !fir.boxproc<() -> i32> { +!CHECK: %{{.*}}:2 = hlfir.declare %[[ARG]] dummy_scope %{{[^ ]*}} +!CHECK-SAME: {fortran_attrs = #fir.var_attrs, uniq_name = "_QFdummy_int_proc_ptrEdummy"} +!CHECK-SAME: : (!fir.ref ()>>, !fir.dscope) +!CHECK-SAME: -> (!fir.ref ()>>, !fir.ref ()>>) +function dummy_int_proc_ptr() result(fun) + interface + integer function int_fun() + end function + end interface + + procedure (int_fun), pointer :: fun, dummy_int_proc_ptr_entry, dummy + fun => null() + return + + entry dummy_int_proc_ptr_entry(dummy) +end function