[flang] Allow pointer association between derived-type pointer and unlimited polymorphic target

[clementval]

Summary

Pointer association to unlimited polymorphic target is allowed for
unlimited polymorphic pointer and non-extensible derived-type.
This is checked by the semantic and this patch allows it in the
fir.rebox operation.

[jeanPerier]

Funny Fortran feature, LGTM.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Optimizer/Dialect/FIROps.cpp

if (inputEleTy != outEleTy) {
     // TODO: check that outBoxTy is a parent type of inputBoxTy for derived
     // types.
     // Character input and output types with constant length may be different if
     // there is a substring in the slice, otherwise, they must match. If any of
     // the types is a character with dynamic length, the other type can be any
     // character type.
     const bool typeCanMismatch =
         inputEleTy.isa<fir::RecordType>() || outEleTy.isa<mlir::NoneType>() ||
+        (inputEleTy.isa<mlir::NoneType>() && outEleTy.isa<fir::RecordType>()) ||
         (getSlice() && inputEleTy.isa<fir::CharacterType>()) ||
         areCompatibleCharacterTypes(inputEleTy, outEleTy);
     if (!typeCanMismatch)
       return emitOpError(
           "op input and output element types must match for intrinsic types");
   }
   return mlir::success();
 }

flang/test/Lower/polymorphic.f90

module polymorphic_test
   type p3
     class(p3), pointer :: p(:)
   end type
 
   type outer
     type(p1) :: inner
   end type
 
+  type non_extensible
+    sequence
+    integer :: d
+  end type
+
   contains
 
   elemental subroutine assign_p1_int(lhs, rhs)
     class(p1), intent(inout) :: lhs
     integer, intent(in) :: rhs
     lhs%a = rhs
     lhs%b = rhs
   End Subroutine
subroutine test_polymorphic_intentout(a)
     class(p1), intent(out) :: a
   end subroutine
 
 ! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_polymorphic_intentout(
 ! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {fir.bindc_name = "a"}) {
 ! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.box<none>
 ! CHECK: %{{.*}} = fir.call @_FortranAInitialize(%[[BOX_NONE]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.box<none>, !fir.ref<i8>, i32) -> none
 
+  subroutine rebox_up_to_record_type(p)
+    class(*), allocatable, target :: p(:,:)
+    type(non_extensible), pointer :: t(:,:)
+    t => p
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPrebox_up_to_record_type(
+! CHECK-SAME: %[[P:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.array<?x?xnone>>>> {fir.bindc_name = "p", fir.target}) {
+! CHECK: %[[T:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x?x!fir.type<_QMpolymorphic_testTnon_extensible{d:i32}>>>> {bindc_name = "t", uniq_name = "_QMpolymorphic_testFrebox_up_to_record_typeEt"}
+! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.heap<!fir.array<?x?xnone>>>>
+! CHECK: %[[REBOX:.*]] = fir.rebox %[[LOAD_P]](%{{.*}}) : (!fir.class<!fir.heap<!fir.array<?x?xnone>>>, !fir.shift<2>) -> !fir.box<!fir.ptr<!fir.array<?x?x!fir.type<_QMpolymorphic_testTnon_extensible{d:i32}>>>>
+! CHECK: fir.store %[[REBOX]] to %[[T]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.type<_QMpolymorphic_testTnon_extensible{d:i32}>>>>>
+
 end module
 
 program test
   use polymorphic_test
   type(outer), allocatable :: o
   integer :: i(5)
   logical :: l(5)
   allocate(o)