From b97beb563150e68ff52787ffea2833100906f2f8 Mon Sep 17 00:00:00 2001 From: Daniel Chen Date: Thu, 16 Oct 2025 17:08:46 -0400 Subject: [PATCH 1/2] To support unlimited polymorphic argument for intrinsic MERGE. --- .../include/flang/Optimizer/Dialect/FIRType.h | 3 + flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 3 +- flang/lib/Optimizer/Dialect/FIRType.cpp | 19 +++-- flang/test/Lower/polymorphic-temp.f90 | 71 +++++++++++++++++++ 4 files changed, 89 insertions(+), 7 deletions(-) diff --git a/flang/include/flang/Optimizer/Dialect/FIRType.h b/flang/include/flang/Optimizer/Dialect/FIRType.h index 6188c4460dadd..430f011c29f96 100644 --- a/flang/include/flang/Optimizer/Dialect/FIRType.h +++ b/flang/include/flang/Optimizer/Dialect/FIRType.h @@ -372,6 +372,9 @@ bool isBoxedRecordType(mlir::Type ty); /// Return true iff `ty` is a type that contains descriptor information. bool isTypeWithDescriptor(mlir::Type ty); +/// Return true if CLASS(*) +bool isClassStarType(mlir::Type ty); + /// Return true iff `ty` is a scalar boxed record type. /// e.g. !fir.box> /// !fir.box>> diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp index e07baafcef0d7..01951784fe476 100644 --- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp +++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp @@ -2169,7 +2169,8 @@ IntrinsicLibrary::genElementalCall( for (const fir::ExtendedValue &arg : args) { auto *box = arg.getBoxOf(); if (!arg.getUnboxed() && !arg.getCharBox() && - !(box && fir::isScalarBoxedRecordType(fir::getBase(*box).getType()))) + !(box && (fir::isScalarBoxedRecordType(fir::getBase(*box).getType()) || + fir::isClassStarType(fir::getBase(*box).getType())))) fir::emitFatalError(loc, "nonscalar intrinsic argument"); } if (outline) diff --git a/flang/lib/Optimizer/Dialect/FIRType.cpp b/flang/lib/Optimizer/Dialect/FIRType.cpp index 4a9579cfde37c..48e162253e0a3 100644 --- a/flang/lib/Optimizer/Dialect/FIRType.cpp +++ b/flang/lib/Optimizer/Dialect/FIRType.cpp @@ -336,6 +336,17 @@ bool isBoxedRecordType(mlir::Type ty) { return false; } +// CLASS(*) +bool isClassStarType(mlir::Type ty) { + if (auto clTy = mlir::dyn_cast(fir::unwrapRefType(ty))) { + if (mlir::isa(clTy.getEleTy())) + return true; + mlir::Type innerType = clTy.unwrapInnerType(); + return innerType && mlir::isa(innerType); + } + return false; +} + bool isScalarBoxedRecordType(mlir::Type ty) { if (auto refTy = fir::dyn_cast_ptrEleTy(ty)) ty = refTy; @@ -398,12 +409,8 @@ bool isPolymorphicType(mlir::Type ty) { bool isUnlimitedPolymorphicType(mlir::Type ty) { // CLASS(*) - if (auto clTy = mlir::dyn_cast(fir::unwrapRefType(ty))) { - if (mlir::isa(clTy.getEleTy())) - return true; - mlir::Type innerType = clTy.unwrapInnerType(); - return innerType && mlir::isa(innerType); - } + if (isClassStarType(ty)) + return true; // TYPE(*) return isAssumedType(ty); } diff --git a/flang/test/Lower/polymorphic-temp.f90 b/flang/test/Lower/polymorphic-temp.f90 index a9db9ba7b7902..ac3cbdba6646d 100644 --- a/flang/test/Lower/polymorphic-temp.f90 +++ b/flang/test/Lower/polymorphic-temp.f90 @@ -223,4 +223,75 @@ subroutine test_merge_intrinsic2(a, b, i) ! CHECK: %[[A_REBOX:.*]] = fir.rebox %[[LOAD_A]] : (!fir.class>>) -> !fir.box>> ! CHECK: %{{.*}} = arith.select %[[CMPI]], %[[A_REBOX]], %[[LOAD_B]] : !fir.box>> + subroutine check_unlimited_poly(a) + class(*), intent(in) :: a + end subroutine + + subroutine test_merge_intrinsic3(a, b, i) + class(*), intent(in) :: a, b + integer, intent(in) :: i + + call check_unlimited_poly(merge(a, b, i==1)) + end subroutine + +! CHECK-LABEL: func.func @_QMpoly_tmpPtest_merge_intrinsic3( +! CHECK-SAME: %[[A:.*]]: !fir.class {fir.bindc_name = "a"}, %[[B:.*]]: !fir.class {fir.bindc_name = "b"}, %[[I:.*]]: !fir.ref {fir.bindc_name = "i"}) { +! CHECK: %[[V_0:[0-9]+]] = fir.load %[[I]] : !fir.ref +! CHECK: %[[C1:.*]] = arith.constant 1 : i32 +! CHECK: %[[V_1:[0-9]+]] = arith.cmpi eq, %[[V_0]], %[[C1]] : i32 +! CHECK: %[[V_2:[0-9]+]] = arith.select %[[V_1]], %[[A]], %[[B]] : !fir.class +! CHECK: fir.call @_QMpoly_tmpPcheck_unlimited_poly(%[[V_2]]) fastmath : (!fir.class) -> () + + subroutine test_merge_intrinsic4(i) + integer, intent(in) :: i + class(*), allocatable :: a, b + + call check_unlimited_poly(merge(a, b, i==1)) + end subroutine + +! CHECK-LABEL: func.func @_QMpoly_tmpPtest_merge_intrinsic4( +! CHECK-SAME: %[[I:.*]]: !fir.ref {fir.bindc_name = "i"}) { +! CHECK: %[[V_0:[0-9]+]] = fir.alloca !fir.class> {bindc_name = "a", uniq_name = "_QMpoly_tmpFtest_merge_intrinsic4Ea"} +! CHECK: %[[V_1:[0-9]+]] = fir.zero_bits !fir.heap +! CHECK: %[[V_2:[0-9]+]] = fir.embox %[[V_1]] : (!fir.heap) -> !fir.class> +! CHECK: fir.store %[[V_2]] to %[[V_0]] : !fir.ref>> +! CHECK: %[[V_3:[0-9]+]] = fir.alloca !fir.class> {bindc_name = "b", uniq_name = "_QMpoly_tmpFtest_merge_intrinsic4Eb"} +! CHECK: %[[V_4:[0-9]+]] = fir.zero_bits !fir.heap +! CHECK: %[[V_5:[0-9]+]] = fir.embox %[[V_4]] : (!fir.heap) -> !fir.class> +! CHECK: fir.store %[[V_5]] to %[[V_3]] : !fir.ref>> +! CHECK: %[[V_6:[0-9]+]] = fir.load %[[V_0]] : !fir.ref>> +! CHECK: %[[V_7:[0-9]+]] = fir.load %[[V_3]] : !fir.ref>> +! CHECK: %[[V_8:[0-9]+]] = fir.load %[[I]] : !fir.ref +! CHECK: %[[C1:.*]] = arith.constant 1 : i32 +! CHECK: %[[V_9:[0-9]+]] = arith.cmpi eq, %[[V_8]], %[[C1]] : i32 +! CHECK: %[[V_10:[0-9]+]] = arith.select %[[V_9]], %[[V_6]], %[[V_7]] : !fir.class> +! CHECK: %[[V_11:[0-9]+]] = fir.rebox %[[V_10]] : (!fir.class>) -> !fir.class +! CHECK: fir.call @_QMpoly_tmpPcheck_unlimited_poly(%[[V_11]]) fastmath : (!fir.class) -> () + + subroutine test_merge_intrinsic5(i) + integer, intent(in) :: i + class(*), pointer :: a, b + + call check_unlimited_poly(merge(a, b, i==1)) + end subroutine + +! CHECK-LABEL: func.func @_QMpoly_tmpPtest_merge_intrinsic5( +! CHECK-SAME: %[[I:.*]]: !fir.ref {fir.bindc_name = "i"}) { +! CHECK: %[[V_0:[0-9]+]] = fir.alloca !fir.class> {bindc_name = "a", uniq_name = "_QMpoly_tmpFtest_merge_intrinsic5Ea"} +! CHECK: %[[V_1:[0-9]+]] = fir.zero_bits !fir.ptr +! CHECK: %[[V_2:[0-9]+]] = fir.embox %[[V_1]] : (!fir.ptr) -> !fir.class> +! CHECK: fir.store %[[V_2]] to %[[V_0]] : !fir.ref>> +! CHECK: %[[V_3:[0-9]+]] = fir.alloca !fir.class> {bindc_name = "b", uniq_name = "_QMpoly_tmpFtest_merge_intrinsic5Eb"} +! CHECK: %[[V_4:[0-9]+]] = fir.zero_bits !fir.ptr +! CHECK: %[[V_5:[0-9]+]] = fir.embox %[[V_4]] : (!fir.ptr) -> !fir.class> +! CHECK: fir.store %[[V_5]] to %[[V_3]] : !fir.ref>> +! CHECK: %[[V_6:[0-9]+]] = fir.load %[[V_0]] : !fir.ref>> +! CHECK: %[[V_7:[0-9]+]] = fir.load %[[V_3]] : !fir.ref>> +! CHECK: %[[V_8:[0-9]+]] = fir.load %[[I]] : !fir.ref +! CHECK: %[[C1:.*]] = arith.constant 1 : i32 +! CHECK: %[[V_9:[0-9]+]] = arith.cmpi eq, %[[V_8]], %[[C1]] : i32 +! CHECK: %[[V_10:[0-9]+]] = arith.select %[[V_9]], %[[V_6]], %[[V_7]] : !fir.class> +! CHECK: %[[V_11:[0-9]+]] = fir.rebox %[[V_10]] : (!fir.class>) -> !fir.class +! CHECK: fir.call @_QMpoly_tmpPcheck_unlimited_poly(%[[V_11]]) fastmath : (!fir.class) -> () + end module From f00a60ed4e3a65476dbb6f46eb2ebd64a00ad2c9 Mon Sep 17 00:00:00 2001 From: Daniel Chen Date: Fri, 17 Oct 2025 10:41:52 -0400 Subject: [PATCH 2/2] To address review comment to move isClassStarType closer to isAssumedType and isUnlimitedPolymorphicType declaration. --- flang/include/flang/Optimizer/Dialect/FIRType.h | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/flang/include/flang/Optimizer/Dialect/FIRType.h b/flang/include/flang/Optimizer/Dialect/FIRType.h index 430f011c29f96..ceee24af0d201 100644 --- a/flang/include/flang/Optimizer/Dialect/FIRType.h +++ b/flang/include/flang/Optimizer/Dialect/FIRType.h @@ -372,9 +372,6 @@ bool isBoxedRecordType(mlir::Type ty); /// Return true iff `ty` is a type that contains descriptor information. bool isTypeWithDescriptor(mlir::Type ty); -/// Return true if CLASS(*) -bool isClassStarType(mlir::Type ty); - /// Return true iff `ty` is a scalar boxed record type. /// e.g. !fir.box> /// !fir.box>> @@ -392,6 +389,9 @@ bool isPolymorphicType(mlir::Type ty); /// value. bool isUnlimitedPolymorphicType(mlir::Type ty); +/// Return true if CLASS(*) +bool isClassStarType(mlir::Type ty); + /// 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>`.