[flang-commits] [flang] 839435c - [flang] Fix fir::isPolymorphic for TYPE(*) assumed-size arrays (#77339)
via flang-commits
flang-commits at lists.llvm.org
Tue Jan 9 03:23:25 PST 2024
Author: jeanPerier
Date: 2024-01-09T12:23:21+01:00
New Revision: 839435cc6ccbd84fff20790285af84bdba83778a
URL: https://github.com/llvm/llvm-project/commit/839435cc6ccbd84fff20790285af84bdba83778a
DIFF: https://github.com/llvm/llvm-project/commit/839435cc6ccbd84fff20790285af84bdba83778a.diff
LOG: [flang] Fix fir::isPolymorphic for TYPE(*) assumed-size arrays (#77339)
fir::isPolymorphic was returning false for TYPE(*) assumed-size arrays
causing bad fir.rebox to be created when passing a polymorphic actual
argument to such TYPE(*) dummy.
Fix fir::isAssumedSize to return true for fir.ref<fir.array<none>> and
fir.ref<none>.
@cabreraam, I found this bug when testing your patch, although it is not
caused by it, so you may hit it when passing TYPE(*) deferred shape of
to assumed size TYPE(*) with a different rank.
Added:
flang/test/Lower/HLFIR/calls-poly-to-assumed-type.f90
Modified:
flang/include/flang/Optimizer/Dialect/FIRType.h
flang/lib/Optimizer/Dialect/FIRType.cpp
flang/test/Lower/polymorphic.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Optimizer/Dialect/FIRType.h b/flang/include/flang/Optimizer/Dialect/FIRType.h
index ecfa9839617dab..8672fcaf60f705 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 d0c7bae674b6cf..110b3a5e0620e2 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<fir::BoxType>()) {
- if (boxTy.getEleTy().isa<mlir::NoneType>())
- return true;
- if (auto seqTy = boxTy.getEleTy().dyn_cast<fir::SequenceType>())
- return seqTy.getEleTy().isa<mlir::NoneType>();
- }
- return false;
+ // Rule out CLASS(*) which are `fir.class<[fir.array] none>`.
+ if (mlir::isa<fir::ClassType>(ty))
+ return false;
+ mlir::Type valueType = fir::unwrapPassByRefType(fir::unwrapRefType(ty));
+ // Refuse raw `none` or `fir.array<none>` since assumed type
+ // should be in memory variables.
+ if (valueType == ty)
+ return false;
+ mlir::Type inner = fir::unwrapSequenceType(valueType);
+ return mlir::isa<mlir::NoneType>(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<fir::ClassType>())
+ // CLASS(T) or CLASS(*)
+ if (mlir::isa<fir::ClassType>(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<fir::ClassType>()) {
+ if (auto clTy = mlir::dyn_cast<fir::ClassType>(fir::unwrapRefType(ty))) {
if (clTy.getEleTy().isa<mlir::NoneType>())
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 00000000000000..ffd21e01ef98dd
--- /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<target>, uniq_name = "_QFpass_poly_to_assumed_type_assumed_sizeEx"} : (!fir.class<!fir.array<?x?xnone>>) -> (!fir.class<!fir.array<?x?xnone>>, !fir.class<!fir.array<?x?xnone>>)
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.copy_in %[[VAL_1]]#0 : (!fir.class<!fir.array<?x?xnone>>) -> (!fir.class<!fir.array<?x?xnone>>, i1)
+! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]]#0 : (!fir.class<!fir.array<?x?xnone>>) -> !fir.ref<!fir.array<?x?xnone>>
+! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<!fir.array<?x?xnone>>) -> !fir.ref<!fir.array<?xnone>>
+! CHECK: fir.call @_QPassumed_type_assumed_size(%[[VAL_4]]) fastmath<contract> : (!fir.ref<!fir.array<?xnone>>) -> ()
+! CHECK: hlfir.copy_out %[[VAL_2]]#0, %[[VAL_2]]#1 to %[[VAL_1]]#0 : (!fir.class<!fir.array<?x?xnone>>, i1, !fir.class<!fir.array<?x?xnone>>) -> ()
diff --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90
index 1770b34d0fe1aa..a813eff690b77e 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<none>
! CHECK: %[[PTR_LOAD2:.*]] = fir.load %[[NULL_PTR]] : !fir.ref<!fir.box<!fir.ptr<none>>>
-! CHECK: %[[BOX_ADDR2:.*]] = fir.box_addr %[[PTR_LOAD2]] : (!fir.box<!fir.ptr<none>>) -> !fir.ptr<none>
-! CHECK: %[[BOX_NONE:.*]] = fir.embox %[[BOX_ADDR2]] : (!fir.ptr<none>) -> !fir.box<none>
-! CHECK: %[[CLASS_NONE:.*]] = fir.convert %[[BOX_NONE]] : (!fir.box<none>) -> !fir.class<none>
+! CHECK: %[[CLASS_NONE:.*]] = fir.rebox %[[PTR_LOAD2]] : (!fir.box<!fir.ptr<none>>) -> !fir.class<none>
! CHECK: %[[ARG:.*]] = arith.select %[[IS_ALLOCATED_OR_ASSOCIATED]], %[[CLASS_NONE]], %[[ABSENT]] : !fir.class<none>
! CHECK: fir.call @_QMpolymorphic_testPsub_with_poly_optional(%[[ARG]]) {{.*}} : (!fir.class<none>) -> ()
More information about the flang-commits
mailing list