diff --git a/flang/include/flang/Optimizer/Dialect/FIRType.h b/flang/include/flang/Optimizer/Dialect/FIRType.h index ecfa9839617da..8672fcaf60f70 100644 --- a/flang/include/flang/Optimizer/Dialect/FIRType.h +++ b/flang/include/flang/Optimizer/Dialect/FIRType.h @@ -330,7 +330,9 @@ bool isPolymorphicType(mlir::Type ty); /// value. bool isUnlimitedPolymorphicType(mlir::Type ty); -/// Return true iff `ty` is the type of an assumed type. +/// Return true iff `ty` is the type of an assumed type. In FIR, +/// assumed types are of the form `[fir.ref|ptr|heap]fir.box<[fir.array]none>`, +/// or `fir.ref|ptr|heap<[fir.array]none>`. bool isAssumedType(mlir::Type ty); /// Return true iff `ty` is the type of an assumed shape array. diff --git a/flang/lib/Optimizer/Dialect/FIRType.cpp b/flang/lib/Optimizer/Dialect/FIRType.cpp index d0c7bae674b6c..110b3a5e0620e 100644 --- a/flang/lib/Optimizer/Dialect/FIRType.cpp +++ b/flang/lib/Optimizer/Dialect/FIRType.cpp @@ -302,13 +302,16 @@ bool isScalarBoxedRecordType(mlir::Type ty) { } bool isAssumedType(mlir::Type ty) { - if (auto boxTy = ty.dyn_cast()) { - if (boxTy.getEleTy().isa()) - return true; - if (auto seqTy = boxTy.getEleTy().dyn_cast()) - return seqTy.getEleTy().isa(); - } - return false; + // Rule out CLASS(*) which are `fir.class<[fir.array] none>`. + if (mlir::isa(ty)) + return false; + mlir::Type valueType = fir::unwrapPassByRefType(fir::unwrapRefType(ty)); + // Refuse raw `none` or `fir.array` since assumed type + // should be in memory variables. + if (valueType == ty) + return false; + mlir::Type inner = fir::unwrapSequenceType(valueType); + return mlir::isa(inner); } bool isAssumedShape(mlir::Type ty) { @@ -331,20 +334,16 @@ bool isAllocatableOrPointerArray(mlir::Type ty) { } bool isPolymorphicType(mlir::Type ty) { - if (auto refTy = fir::dyn_cast_ptrEleTy(ty)) - ty = refTy; - // CLASS(*) - if (ty.isa()) + // CLASS(T) or CLASS(*) + if (mlir::isa(fir::unwrapRefType(ty))) return true; // assumed type are polymorphic. return isAssumedType(ty); } bool isUnlimitedPolymorphicType(mlir::Type ty) { - if (auto refTy = fir::dyn_cast_ptrEleTy(ty)) - ty = refTy; // CLASS(*) - if (auto clTy = ty.dyn_cast()) { + if (auto clTy = mlir::dyn_cast(fir::unwrapRefType(ty))) { if (clTy.getEleTy().isa()) return true; mlir::Type innerType = clTy.unwrapInnerType(); diff --git a/flang/test/Lower/HLFIR/calls-poly-to-assumed-type.f90 b/flang/test/Lower/HLFIR/calls-poly-to-assumed-type.f90 new file mode 100644 index 0000000000000..ffd21e01ef98d --- /dev/null +++ b/flang/test/Lower/HLFIR/calls-poly-to-assumed-type.f90 @@ -0,0 +1,20 @@ +! Test passing rank 2 CLASS(*) deferred shape to assumed size assumed type +! This requires copy-in/copy-out logic. +! RUN: bbc -emit-hlfir -polymorphic-type -o - %s | FileCheck %s + +subroutine pass_poly_to_assumed_type_assumed_size(x) + class(*), target :: x(:,:) + interface + subroutine assumed_type_assumed_size(x) + type(*), target :: x(*) + end subroutine + end interface + call assumed_type_assumed_size(x) +end subroutine +! CHECK-LABEL: func.func @_QPpass_poly_to_assumed_type_assumed_size( +! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFpass_poly_to_assumed_type_assumed_sizeEx"} : (!fir.class>) -> (!fir.class>, !fir.class>) +! CHECK: %[[VAL_2:.*]]:2 = hlfir.copy_in %[[VAL_1]]#0 : (!fir.class>) -> (!fir.class>, i1) +! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]]#0 : (!fir.class>) -> !fir.ref> +! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref>) -> !fir.ref> +! CHECK: fir.call @_QPassumed_type_assumed_size(%[[VAL_4]]) fastmath : (!fir.ref>) -> () +! CHECK: hlfir.copy_out %[[VAL_2]]#0, %[[VAL_2]]#1 to %[[VAL_1]]#0 : (!fir.class>, i1, !fir.class>) -> () diff --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90 index 1770b34d0fe1a..a813eff690b77 100644 --- a/flang/test/Lower/polymorphic.f90 +++ b/flang/test/Lower/polymorphic.f90 @@ -839,9 +839,7 @@ subroutine test_call_with_null() ! CHECK: %[[IS_ALLOCATED_OR_ASSOCIATED:.*]] = arith.cmpi ne, %[[BOX_ADDR_I64]], %[[C0]] : i64 ! CHECK: %[[ABSENT:.*]] = fir.absent !fir.class ! CHECK: %[[PTR_LOAD2:.*]] = fir.load %[[NULL_PTR]] : !fir.ref>> -! CHECK: %[[BOX_ADDR2:.*]] = fir.box_addr %[[PTR_LOAD2]] : (!fir.box>) -> !fir.ptr -! CHECK: %[[BOX_NONE:.*]] = fir.embox %[[BOX_ADDR2]] : (!fir.ptr) -> !fir.box -! CHECK: %[[CLASS_NONE:.*]] = fir.convert %[[BOX_NONE]] : (!fir.box) -> !fir.class +! CHECK: %[[CLASS_NONE:.*]] = fir.rebox %[[PTR_LOAD2]] : (!fir.box>) -> !fir.class ! CHECK: %[[ARG:.*]] = arith.select %[[IS_ALLOCATED_OR_ASSOCIATED]], %[[CLASS_NONE]], %[[ABSENT]] : !fir.class ! CHECK: fir.call @_QMpolymorphic_testPsub_with_poly_optional(%[[ARG]]) {{.*}} : (!fir.class) -> ()