[flang-commits] [flang] c44292f - [flang] Enable character type guard in select type
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Fri Dec 2 00:53:57 PST 2022
Author: Valentin Clement
Date: 2022-12-02T09:53:48+01:00
New Revision: c44292f15b0ce0fa1866c80211b341733b043efb
URL: https://github.com/llvm/llvm-project/commit/c44292f15b0ce0fa1866c80211b341733b043efb
DIFF: https://github.com/llvm/llvm-project/commit/c44292f15b0ce0fa1866c80211b341733b043efb.diff
LOG: [flang] Enable character type guard in select type
SELECT TYPE lower and conversion was not handling
`character` type guard. This add support for it.
Reviewed By: jeanPerier
Differential Revision: https://reviews.llvm.org/D139106
Added:
Modified:
flang/include/flang/Optimizer/Builder/Character.h
flang/lib/Lower/Bridge.cpp
flang/lib/Optimizer/Builder/Character.cpp
flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp
flang/test/Lower/select-type.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Optimizer/Builder/Character.h b/flang/include/flang/Optimizer/Builder/Character.h
index 8b952620d1fdd..fca21363da84c 100644
--- a/flang/include/flang/Optimizer/Builder/Character.h
+++ b/flang/include/flang/Optimizer/Builder/Character.h
@@ -176,6 +176,9 @@ class CharacterExprHelper {
/// to the number of characters per the Fortran KIND.
mlir::Value readLengthFromBox(mlir::Value box);
+ /// Same as readLengthFromBox but the CharacterType is provided.
+ mlir::Value readLengthFromBox(mlir::Value box, fir::CharacterType charTy);
+
private:
/// FIXME: the implementation also needs a clean-up now that
/// CharBoxValue are better propagated.
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 18919132759d3..fbe8abe1b9177 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -2236,11 +2236,6 @@ class FirConverter : public Fortran::lower::AbstractConverter {
int kind =
Fortran::evaluate::ToInt64(intrinsic->kind()).value_or(kind);
llvm::SmallVector<Fortran::lower::LenParameterTy> params;
- if (intrinsic->category() ==
- Fortran::common::TypeCategory::Character ||
- intrinsic->category() ==
- Fortran::common::TypeCategory::Derived)
- TODO(loc, "typeSpec with length parameters");
ty = genType(intrinsic->category(), kind, params);
} else {
const Fortran::semantics::DerivedTypeSpec *derived =
@@ -2304,12 +2299,24 @@ class FirConverter : public Fortran::lower::AbstractConverter {
exactValue = builder->create<fir::BoxAddrOp>(
loc, fir::ReferenceType::get(attr.getType()),
fir::getBase(selector));
+ const Fortran::semantics::IntrinsicTypeSpec *intrinsic =
+ typeSpec->declTypeSpec->AsIntrinsic();
+ if (intrinsic->category() ==
+ Fortran::common::TypeCategory::Character) {
+ auto charTy = attr.getType().dyn_cast<fir::CharacterType>();
+ mlir::Value charLen =
+ fir::factory::CharacterExprHelper(*builder, loc)
+ .readLengthFromBox(fir::getBase(selector), charTy);
+ addAssocEntitySymbol(fir::CharBoxValue(exactValue, charLen));
+ } else {
+ addAssocEntitySymbol(exactValue);
+ }
} else if (std::holds_alternative<Fortran::parser::DerivedTypeSpec>(
typeSpec->u)) {
exactValue = builder->create<fir::ConvertOp>(
loc, fir::BoxType::get(attr.getType()), fir::getBase(selector));
+ addAssocEntitySymbol(exactValue);
}
- addAssocEntitySymbol(exactValue);
} else if (std::holds_alternative<Fortran::parser::DerivedTypeSpec>(
guard.u)) {
// CLASS IS
diff --git a/flang/lib/Optimizer/Builder/Character.cpp b/flang/lib/Optimizer/Builder/Character.cpp
index ba5b18e762e06..89a8e8c7e310c 100644
--- a/flang/lib/Optimizer/Builder/Character.cpp
+++ b/flang/lib/Optimizer/Builder/Character.cpp
@@ -664,9 +664,14 @@ mlir::Value fir::factory::CharacterExprHelper::extractCodeFromSingleton(
mlir::Value
fir::factory::CharacterExprHelper::readLengthFromBox(mlir::Value box) {
+ auto charTy = recoverCharacterType(box.getType());
+ return readLengthFromBox(box, charTy);
+}
+
+mlir::Value fir::factory::CharacterExprHelper::readLengthFromBox(
+ mlir::Value box, fir::CharacterType charTy) {
auto lenTy = builder.getCharacterLengthType();
auto size = builder.create<fir::BoxEleSizeOp>(loc, lenTy, box);
- auto charTy = recoverCharacterType(box.getType());
auto bits = builder.getKindMap().getCharacterBitsize(charTy.getFKind());
auto width = bits / 8;
if (width > 1) {
diff --git a/flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp b/flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp
index af13fecaaa8fd..14e8c5868b758 100644
--- a/flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp
+++ b/flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp
@@ -464,7 +464,10 @@ class CfgSelectTypeConv : public OpConversionPattern<fir::SelectTypeOp> {
return fir::complexBitsToTypeCode(
kindMap.getRealBitsize(cmplxTy.getFKind()));
}
- return 0; // TODO more types.
+ if (auto charTy = ty.dyn_cast<fir::CharacterType>())
+ return fir::characterBitsToTypeCode(
+ kindMap.getCharacterBitsize(charTy.getFKind()));
+ return 0;
}
mlir::LogicalResult
@@ -476,13 +479,14 @@ class CfgSelectTypeConv : public OpConversionPattern<fir::SelectTypeOp> {
mlir::Value cmp;
// TYPE IS type guard comparison are all done inlined.
if (auto a = attr.dyn_cast<fir::ExactTypeAttr>()) {
- if (fir::isa_trivial(a.getType())) {
+ if (fir::isa_trivial(a.getType()) ||
+ a.getType().isa<fir::CharacterType>()) {
// For type guard statement with Intrinsic type spec the type code of
// the descriptor is compared.
int code = getTypeCode(a.getType(), kindMap);
if (code == 0)
return mlir::emitError(loc)
- << "type code not done for " << a.getType();
+ << "type code unavailable for " << a.getType();
mlir::Value typeCode = rewriter.create<mlir::arith::ConstantOp>(
loc, rewriter.getI8IntegerAttr(code));
mlir::Value selectorTypeCode = rewriter.create<fir::BoxTypeCodeOp>(
diff --git a/flang/test/Lower/select-type.f90 b/flang/test/Lower/select-type.f90
index f14dd58040b3a..744e7d9b2f99e 100644
--- a/flang/test/Lower/select-type.f90
+++ b/flang/test/Lower/select-type.f90
@@ -253,6 +253,8 @@ subroutine select_type5(a)
print*, 'type is real'
type is (logical)
print*, 'type is logical'
+ type is (character(*))
+ print*, 'type is character'
class default
print*,'default'
end select
@@ -261,14 +263,57 @@ subroutine select_type5(a)
! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type5(
! CHECK-SAME: %[[ARG0:.*]]: !fir.class<none> {fir.bindc_name = "a"})
! CHECK: fir.select_type %[[ARG0]] : !fir.class<none>
-! CHECK-SAME: [#fir.type_is<i8>, ^[[I8_BLK:.*]], #fir.type_is<i32>, ^[[I32_BLK:.*]], #fir.type_is<f32>, ^[[F32_BLK:.*]], #fir.type_is<!fir.logical<4>>, ^[[LOG_BLK:.*]], unit, ^[[DEFAULT:.*]]]
+! CHECK-SAME: [#fir.type_is<i8>, ^[[I8_BLK:.*]], #fir.type_is<i32>, ^[[I32_BLK:.*]], #fir.type_is<f32>, ^[[F32_BLK:.*]], #fir.type_is<!fir.logical<4>>, ^[[LOG_BLK:.*]], #fir.type_is<!fir.char<1,?>>, ^[[CHAR_BLK:.*]], unit, ^[[DEFAULT:.*]]]
! CHECK: ^[[I8_BLK]]
! CHECK: ^[[I32_BLK]]
! CHECK: ^[[F32_BLK]]
! CHECK: ^[[LOG_BLK]]
+! CHECK: ^[[CHAR_BLK]]
! CHECK: ^[[DEFAULT_BLOCK]]
! CFG-LABEL: func.func @_QMselect_type_lower_testPselect_type5(
+! CFG-SAME: %[[SELECTOR:.*]]: !fir.class<none> {fir.bindc_name = "a"}) {
+
+! CFG: %[[INT8_TC:.*]] = arith.constant 7 : i8
+! CFG: %[[TYPE_CODE:.*]] = fir.box_typecode %[[SELECTOR]] : (!fir.class<none>) -> i8
+! CFG: %[[IS_INT8:.*]] = arith.cmpi eq, %[[TYPE_CODE]], %[[INT8_TC]] : i8
+! CFG: cf.cond_br %[[IS_INT8]], ^[[INT8_BLK:.*]], ^[[NOT_INT8:.*]]
+! CFG: ^[[NOT_INT8]]:
+! CFG: %[[INT32_TC:.*]] = arith.constant 9 : i8
+! CFG: %[[TYPE_CODE:.*]] = fir.box_typecode %[[SELECTOR]] : (!fir.class<none>) -> i8
+! CFG: %[[IS_INT32:.*]] = arith.cmpi eq, %[[TYPE_CODE]], %[[INT32_TC]] : i8
+! CFG: cf.cond_br %[[IS_INT32]], ^[[INT32_BLK:.*]], ^[[NOT_INT32_BLK:.*]]
+! CFG: ^[[INT8_BLK]]:
+! CFG: cf.br ^[[EXIT_BLK:.*]]
+! CFG: ^[[NOT_INT32_BLK]]:
+! CFG: %[[FLOAT_TC:.*]] = arith.constant 27 : i8
+! CFG: %[[TYPE_CODE:.*]] = fir.box_typecode %[[SELECTOR]] : (!fir.class<none>) -> i8
+! CFG: %[[IS_FLOAT:.*]] = arith.cmpi eq, %[[TYPE_CODE]], %[[FLOAT_TC]] : i8
+! CFG: cf.cond_br %[[IS_FLOAT]], ^[[FLOAT_BLK:.*]], ^[[NOT_FLOAT_BLK:.*]]
+! CFG: ^[[INT32_BLK]]:
+! CFG: cf.br ^[[EXIT_BLK]]
+! CFG: ^[[NOT_FLOAT_BLK]]:
+! CFG: %[[LOGICAL_TC:.*]] = arith.constant 14 : i8
+! CFG: %[[TYPE_CODE:.*]] = fir.box_typecode %[[SELECTOR]] : (!fir.class<none>) -> i8
+! CFG: %[[IS_LOGICAL:.*]] = arith.cmpi eq, %[[TYPE_CODE]], %[[LOGICAL_TC]] : i8
+! CFG: cf.cond_br %[[IS_LOGICAL]], ^[[LOGICAL_BLK:.*]], ^[[NOT_LOGICAL_BLK:.*]]
+! CFG: ^[[FLOAT_BLK]]:
+! CFG: cf.br ^[[EXIT_BLK]]
+! CFG: ^[[NOT_LOGICAL_BLK]]:
+! CFG: %[[CHAR_TC:.*]] = arith.constant 40 : i8
+! CFG: %[[TYPE_CODE:.*]] = fir.box_typecode %[[SELECTOR]] : (!fir.class<none>) -> i8
+! CFG: %[[IS_CHAR:.*]] = arith.cmpi eq, %[[TYPE_CODE]], %[[CHAR_TC]] : i8
+! CFG: cf.cond_br %[[IS_CHAR]], ^[[CHAR_BLK:.*]], ^[[NOT_CHAR_BLK:.*]]
+! CFG: ^[[LOGICAL_BLK]]:
+! CFG: cf.br ^[[EXIT_BLK]]
+! CFG: ^[[NOT_CHAR_BLK]]:
+! CFG: cf.br ^[[DEFAULT_BLK:.*]]
+! CFG: ^[[CHAR_BLK]]:
+! CFG: cf.br ^[[EXIT_BLK]]
+! CFG: ^[[DEFAULT_BLK]]:
+! CFG: cf.br ^[[EXIT_BLK]]
+! CFG: ^bb12:
+! CFG: return
subroutine select_type6(a)
class(*) :: a
More information about the flang-commits
mailing list