Index: flang/lib/Optimizer/Builder/FIRBuilder.cpp =================================================================== --- flang/lib/Optimizer/Builder/FIRBuilder.cpp +++ flang/lib/Optimizer/Builder/FIRBuilder.cpp @@ -319,9 +319,20 @@ if (fir::isa_ref_type(toTy) && fir::isa_box_type(fromTy)) { // Call is expecting a raw data pointer, not a box. Get the data pointer out // of the box and pass that. - assert((fir::unwrapRefType(toTy) == - fir::unwrapRefType(fir::unwrapPassByRefType(fromTy)) && - "element types expected to match")); + mlir::Type toEleTy = fir::unwrapRefType(toTy); + mlir::Type fromEleTy = fir::unwrapRefType(fir::unwrapPassByRefType(fromTy)); + if (toEleTy != fromEleTy && toEleTy.isa() && + fromEleTy.isa()) { + auto seqTy = toEleTy.dyn_cast(); + llvm::SmallVector extents = + fir::factory::createExtents(*this, loc, seqTy); + auto shapeTy = fir::ShapeType::get(getContext(), extents.size()); + mlir::Value shape = create(loc, shapeTy, extents); + mlir::Value newBoxVal = create( + loc, fir::BoxType::get(seqTy), val, shape, /*slice=*/mlir::Value{}); + return create(loc, toTy, newBoxVal); + } + assert(toEleTy == fromEleTy && "element types expected to match"); return create(loc, toTy, val); } Index: flang/test/Lower/arg-rank-mismatch.f90 =================================================================== --- /dev/null +++ flang/test/Lower/arg-rank-mismatch.f90 @@ -0,0 +1,54 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: func.func @_QMm_testPtest_func( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box> {fir.bindc_name = "i2", fir.target}) -> !fir.box>> { +! CHECK: %[[VAL_16:.*]] = fir.undefined index +! CHECK: %[[VAL_17:.*]] = fir.shape %[[VAL_16]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_18:.*]] = fir.rebox %[[VAL_0]](%[[VAL_17]]) : (!fir.box>, !fir.shape<1>) -> !fir.box> +! CHECK: %[[VAL_19:.*]] = fir.box_addr %[[VAL_18]] : (!fir.box>) -> !fir.ref> +! CHECK: %[[VAL_20:.*]] = fir.call @_QPext_interface(%{{.*}}, %[[VAL_19]]) : (!fir.ref, !fir.ref>) -> !fir.box>> +! CHECK: } + +module m_test + implicit none + private + public :: test + + interface test + module procedure test_func + end interface test + +CONTAINS + + function test_func(i2) result(i1) + implicit none + real,dimension(:,:),target,intent(in):: i2 + real,pointer,dimension(:):: i1 + + interface + function ext_interface(ln,i2) result(i1) + implicit none + integer,intent(in) :: ln + real,dimension(:,:),target,intent(in):: i2 + real,pointer,dimension(:):: i1 + end function ext_interface + end interface + + i1 => ext_interface(size(i2),i2) + end +end + +program main + use m_test + real, target :: a(2,2) = reshape([1.,2.,3.,4.], [2,2]) + real,pointer,dimension(:):: t + t=>test(a) +end + +function ext_interface(ln,i2) result(i1) + implicit none + integer,intent(in) :: ln + real,dimension(ln),target,intent(in):: i2 + real,pointer,dimension(:):: i1 + i1 => i2 +end