[flang-commits] [PATCH] D144952: [flang][hlfir] Support type bound procedure in type descriptors

[Jean Perier via Phabricator via flang-commits]

jeanPerier created this revision.
jeanPerier added a reviewer: clementval.
jeanPerier added a project: Flang.
Herald added subscribers: sunshaoce, mehdi_amini, jdoerfert.
Herald added a project: All.
jeanPerier requested review of this revision.

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.


Repository:
  rG LLVM Github Monorepo

https://reviews.llvm.org/D144952

Files:
  flang/lib/Lower/ConvertConstant.cpp
  flang/test/Lower/HLFIR/type-bound-proc-tdesc.f90


Index: flang/test/Lower/HLFIR/type-bound-proc-tdesc.f90
===================================================================
--- /dev/null
+++ 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<() -> ()>) -> (() -> ())
Index: flang/lib/Lower/ConvertConstant.cpp
===================================================================
--- flang/lib/Lower/ConvertConstant.cpp
+++ flang/lib/Lower/ConvertConstant.cpp
@@ -374,6 +374,8 @@
         // 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");


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D144952.501067.patch
Type: text/x-patch
Size: 2146 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20230228/47714434/attachment-0001.bin>