[flang] Handle correctly polymorphic descriptor for IO input

[clementval]

Summary

Polymorphic entities are already emboxed. Just update
the code to use BaseBoxType instead of BoxType.

[jeanPerier]

LGTM

[clementval]

Rebase

flang/lib/Lower/IO.cpp

 
 static mlir::Value createIoRuntimeCallForItem(mlir::Location loc,
                                               fir::FirOpBuilder &builder,
                                               mlir::func::FuncOp inputFunc,
                                               mlir::Value cookie,
                                               const fir::ExtendedValue &item) {
   mlir::Type argType = inputFunc.getFunctionType().getInput(1);
   llvm::SmallVector<mlir::Value> inputFuncArgs = {cookie};
-  if (argType.isa<fir::BoxType>()) {
+  if (argType.isa<fir::BaseBoxType>()) {
     mlir::Value box = fir::getBase(item);
-    assert(box.getType().isa<fir::BoxType>() && "must be previously emboxed");
+    assert(box.getType().isa<fir::BaseBoxType>() && "must be previously emboxed");
     inputFuncArgs.push_back(builder.createConvert(loc, argType, box));
   } else {
     mlir::Value itemAddr = fir::getBase(item);
     mlir::Type itemTy = fir::unwrapPassByRefType(itemAddr.getType());
     inputFuncArgs.push_back(builder.createConvert(loc, argType, itemAddr));
     fir::factory::CharacterExprHelper charHelper{builder, loc};
     if (charHelper.isCharacterScalar(itemTy)) {
       mlir::Value len = fir::getLen(item);

flang/test/Lower/polymorphic.f90

 ! RUN: bbc -polymorphic-type -emit-fir %s -o - | FileCheck %s
 
 ! Tests various aspect of the lowering of polymorphic entities.
 
 module polymorphic_test
   type p1
     integer :: a
     integer :: b
   contains
     procedure :: print
     procedure :: assign_p1_int
     procedure :: elemental_fct
     procedure :: elemental_sub
     procedure, pass(this) :: elemental_sub_pass
+    procedure :: read_p1
+    procedure :: write_p1
+    generic :: read(formatted) => read_p1
+    generic :: write(formatted) => write_p1
     generic :: assignment(=) => assign_p1_int
     procedure :: host_assoc
     procedure, pass(poly) :: lt
     generic :: operator(<) => lt
   end type
 
   type, extends(p1) :: p2
     real :: c

 ! CHECK: %[[C0:.*]] = arith.constant 0 : index
 ! CHECK: %[[UB:.*]] = arith.subi %[[P_DIMS]]#1, %[[C1]] : index
 ! CHECK: fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] {
 ! CHECK:   %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[IND]] : (!fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
 ! CHECK:   %[[EMBOXED:.*]] = fir.embox %[[COORD]] tdesc %[[TDESC]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.tdesc<none>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
 ! CHECK:   fir.dispatch "elemental_sub_pass"(%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) (%{{.*}}, %[[EMBOXED]] : !fir.ref<i32>, !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) {pass_arg_pos = 1 : i32}
 ! CHECK: }
 
+  subroutine write_p1(dtv, unit, iotype, v_list, iostat, iomsg)
+    class(p1), intent(in) :: dtv
+    integer, intent(in) :: unit
+    character(*), intent(in) :: iotype
+    integer, intent(in) :: v_list(:)
+    integer, intent(out) :: iostat
+    character(*), intent(inout) :: iomsg
+    ! dummy subroutine for testing purpose
+  end subroutine
+
+  subroutine read_p1(dtv, unit, iotype, v_list, iostat, iomsg)
+    class(p1), intent(inout) :: dtv
+    integer, intent(in) :: unit
+    character(*), intent(in) :: iotype
+    integer, intent(in) :: v_list(:)
+    integer, intent(out) :: iostat
+    character(*), intent(inout) :: iomsg
+    ! dummy subroutine for testing purpose
+  end subroutine
+
+  subroutine test_polymorphic_io()
+    type(p1), target :: t
+    class(p1), pointer :: p
+    open(17, form='formatted', access='stream')
+    write(17, 1) t
+    1 Format(1X,I10)
+    p => t
+    rewind(17)
+    read(17, 1) p
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_polymorphic_io() {
+! CHECK: %[[P:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {bindc_name = "p", uniq_name = "_QMpolymorphic_testFtest_polymorphic_ioEp"}
+! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>
+! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[LOAD_P]] : (!fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranAioInputDescriptor(%{{.*}}, %[[BOX_NONE]]) {{.*}} : (!fir.ref<i8>, !fir.box<none>) -> i1
+
 end module
 
 program test
   use polymorphic_test
   type(outer), allocatable :: o
   integer :: i(5)
   logical :: l(5)
   allocate(o)