[flang-commits] [flang] a98b031 - [flang][hlfir] Support type bound procedure in type descriptors

[Jean Perier via flang-commits]

Author: Jean Perier
Date: 2023-02-28T14:11:44+01:00
New Revision: a98b031e4f38520dbf53c2f25efac6c4dd77d0b5

URL: https://github.com/llvm/llvm-project/commit/a98b031e4f38520dbf53c2f25efac6c4dd77d0b5
DIFF: https://github.com/llvm/llvm-project/commit/a98b031e4f38520dbf53c2f25efac6c4dd77d0b5.diff

LOG: [flang][hlfir] Support type bound procedure in type descriptors

In hlfir, procedure designators are propagated as fir.box_proc.
Derived type descriptors are compiler generated constant structure
constructors. They contain CFPTR components for the type bound
procedure addresses.
Before being cast to an integer type so that they can be stored
in the CFPTR components, the fir.box_proc addresses must be
obtained with a fir.box_addr.

Differential Revision: https://reviews.llvm.org/D144952

Added: 
    flang/test/Lower/HLFIR/type-bound-proc-tdesc.f90

Modified: 
    flang/lib/Lower/ConvertConstant.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/ConvertConstant.cpp b/flang/lib/Lower/ConvertConstant.cpp
index 331aa7e7c7f7e..a391d71498e76 100644
--- a/flang/lib/Lower/ConvertConstant.cpp
+++ b/flang/lib/Lower/ConvertConstant.cpp
@@ -374,6 +374,8 @@ static mlir::Value genInlinedStructureCtorLitImpl(
         // The Ev::Expr returned is an initializer that is a pointer (e.g.,
         // null) that must be inserted into an intermediate cptr record
         // value's address field, which ought to be an intptr_t on the target.
+        if (addr.getType().isa<fir::BoxProcType>())
+          addr = builder.create<fir::BoxAddrOp>(loc, addr);
         assert((fir::isa_ref_type(addr.getType()) ||
                 addr.getType().isa<mlir::FunctionType>()) &&
                "expect reference type for address field");

diff  --git a/flang/test/Lower/HLFIR/type-bound-proc-tdesc.f90 b/flang/test/Lower/HLFIR/type-bound-proc-tdesc.f90
new file mode 100644
index 0000000000000..fed2097b0c138
--- /dev/null
+++ b/flang/test/Lower/HLFIR/type-bound-proc-tdesc.f90
@@ -0,0 +1,31 @@
+! Test lowering of type bound procedure in the derived type descriptors (that
+! are compiler generated constant structure constructors).
+! RUN: bbc -emit-fir -hlfir -o - %s | FileCheck %s
+
+module type_bound_proc_tdesc
+  type :: t
+  contains
+    procedure, nopass :: simple => simple_impl
+    procedure, nopass :: return_char => return_char_impl
+  end type
+
+interface
+  function return_char_impl()
+    character(10) :: return_char_impl
+  end function
+  subroutine simple_impl()
+  end subroutine
+end interface
+end
+  use type_bound_proc_tdesc
+  type(t) :: a
+end
+
+! CHECK-LABEL: fir.global {{.*}} @_QMtype_bound_proc_tdescE.v.t
+! CHECK:  fir.address_of(@_QPreturn_char_impl) : (!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1>
+! CHECK:  %[[VAL_8:.*]] = fir.extract_value %{{.*}}, [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
+! CHECK:  fir.box_addr %[[VAL_8]] : (!fir.boxproc<() -> ()>) -> (() -> ())
+! ...
+! CHECK:  %[[VAL_25:.*]] = fir.address_of(@_QPsimple_impl) : () -> ()
+! CHECK:  %[[VAL_26:.*]] = fir.emboxproc %[[VAL_25]] : (() -> ()) -> !fir.boxproc<() -> ()>
+! CHECK:  fir.box_addr %[[VAL_26]] : (!fir.boxproc<() -> ()>) -> (() -> ())