[flang-commits] [flang] [flang] Fix issues with STORAGE_SIZE and characters (PR #67561)
via flang-commits
flang-commits at lists.llvm.org
Wed Sep 27 10:46:28 PDT 2023
https://github.com/jeanPerier updated https://github.com/llvm/llvm-project/pull/67561
>From 7af1eb5a3270070522bb28784a418eba651a0b2e Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Wed, 27 Sep 2023 03:01:40 -0700
Subject: [PATCH 1/2] [flang] Fix issues with STORAGE_SIZE and characters
Semantics was replacing storage_size(func()) by the
length specification expression of func result (if any), which
brought meaningless symbols. Update FunctionRef::GetType to not
copy its length parameter from the procedure designator symbol if
it is not a constant expression. Note that the deferred aspect can
and must be preserved because it matters for POINTER function
results (semantics test added to ensure this).
Update lowering code to deal with characters in storage_size: simply
always call createBox to ensure the BoxEleSizeOp is legal. This will
take care of dereferencing pointers/allocatables if needed (what the
load was intended for in the previous code).
---
flang/include/flang/Evaluate/call.h | 7 ++++-
flang/include/flang/Evaluate/type.h | 5 ++++
flang/lib/Evaluate/type.cpp | 11 +++++++
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 7 ++---
flang/test/Evaluate/rewrite06.f90 | 14 +++++++++
.../test/Lower/Intrinsics/storage_size-2.f90 | 30 +++++++++++++++++++
flang/test/Semantics/call05.f90 | 19 ++++++++++++
7 files changed, 87 insertions(+), 6 deletions(-)
create mode 100644 flang/test/Evaluate/rewrite06.f90
create mode 100644 flang/test/Lower/Intrinsics/storage_size-2.f90
diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h
index f2c231647390bde..09673f00d7bddf4 100644
--- a/flang/include/flang/Evaluate/call.h
+++ b/flang/include/flang/Evaluate/call.h
@@ -268,7 +268,12 @@ template <typename A> class FunctionRef : public ProcedureRef {
FunctionRef(ProcedureDesignator &&p, ActualArguments &&a)
: ProcedureRef{std::move(p), std::move(a)} {}
- std::optional<DynamicType> GetType() const { return proc_.GetType(); }
+ std::optional<DynamicType> GetType() const {
+ if (auto type = proc_.GetType()) {
+ return type->DropNonConstantParameters();
+ }
+ return std::nullopt;
+ }
};
} // namespace Fortran::evaluate
#endif // FORTRAN_EVALUATE_CALL_H_
diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h
index eb4050970c1381a..6baf9cf0259e33a 100644
--- a/flang/include/flang/Evaluate/type.h
+++ b/flang/include/flang/Evaluate/type.h
@@ -231,6 +231,11 @@ class DynamicType {
}
}
+ // Get a copy of this dynamic type where charLengthParamValue_ is reset if it
+ // is not a constant expression. This avoids propagating symbol references in
+ // scopes where they do not belong.
+ DynamicType DropNonConstantParameters() const;
+
private:
// Special kind codes are used to distinguish the following Fortran types.
enum SpecialKind {
diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp
index 1497c037d9cc6e3..cff265bcd1ff379 100644
--- a/flang/lib/Evaluate/type.cpp
+++ b/flang/lib/Evaluate/type.cpp
@@ -836,4 +836,15 @@ bool IsCUDAIntrinsicType(const DynamicType &type) {
}
}
+DynamicType DynamicType::DropNonConstantParameters() const {
+ if (charLengthParamValue_ && charLengthParamValue_->isExplicit()) {
+ if (std::optional<std::int64_t> len = knownLength()) {
+ return DynamicType(kind_, *len);
+ } else {
+ return DynamicType(category_, kind_);
+ }
+ }
+ return *this;
+}
+
} // namespace Fortran::evaluate
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 1ae8f08dc116eb4..0a023bc6b21ea03 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -5284,11 +5284,8 @@ IntrinsicLibrary::genStorageSize(mlir::Type resultType,
builder.getKindMap().getIntegerBitsize(fir::toInt(constOp)));
}
- if (args[0].getBoxOf<fir::PolymorphicValue>()) {
- box = builder.createBox(loc, args[0], /*isPolymorphic=*/true);
- } else if (box.getType().isa<fir::ReferenceType>()) {
- box = builder.create<fir::LoadOp>(loc, box);
- }
+ box = builder.createBox(loc, args[0],
+ /*isPolymorphic=*/args[0].isPolymorphic());
mlir::Value eleSize = builder.create<fir::BoxEleSizeOp>(loc, kindTy, box);
mlir::Value c8 = builder.createIntegerConstant(loc, kindTy, 8);
return builder.create<mlir::arith::MulIOp>(loc, eleSize, c8);
diff --git a/flang/test/Evaluate/rewrite06.f90 b/flang/test/Evaluate/rewrite06.f90
new file mode 100644
index 000000000000000..8f6aa200b4140dc
--- /dev/null
+++ b/flang/test/Evaluate/rewrite06.f90
@@ -0,0 +1,14 @@
+! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+subroutine test_storage_size(n)
+ interface
+ function return_char(l)
+ integer :: l
+ character(l) :: return_char
+ end function
+ end interface
+ integer n
+ !CHECK: PRINT *, storage_size(return_char(n))
+ print*, storage_size(return_char(n))
+ !CHECK: PRINT *, sizeof(return_char(n))
+ print*, sizeof(return_char(n))
+end subroutine
diff --git a/flang/test/Lower/Intrinsics/storage_size-2.f90 b/flang/test/Lower/Intrinsics/storage_size-2.f90
new file mode 100644
index 000000000000000..e784063c76c350c
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/storage_size-2.f90
@@ -0,0 +1,30 @@
+! Test storage_size with characters
+! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
+
+! check-label: func.func @_QPtest_storage_size
+subroutine test_storage_size(n)
+ interface
+ function return_char(l)
+ integer :: l
+ character(l) :: return_char
+ end function
+ end interface
+ integer n
+ print*, storage_size(return_char(n))
+! CHECK: %[[val_16:.*]] = fir.call @_QPreturn_char(%[[res_addr:[^,]*]], %[[res_len:[^,]*]], {{.*}})
+! CHECK: %[[res:.*]]:2 = hlfir.declare %[[res_addr]] typeparams %[[res_len]]
+! CHECK: %[[val_18:.*]] = fir.embox %[[res]]#1 typeparams %[[res_len]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+! CHECK: %[[val_19:.*]] = fir.box_elesize %[[val_18]] : (!fir.box<!fir.char<1,?>>) -> i32
+! CHECK: %[[val_20:.*]] = arith.constant 8 : i32
+! CHECK: %[[val_21:.*]] = arith.muli %[[val_19]], %[[val_20]] : i32
+! CHECK: fir.call @_FortranAioOutputInteger32(%{{.*}}, %[[val_21]])
+end subroutine
+
+function return_char(l)
+ integer :: l
+ character(l) :: return_char
+end function
+
+ call test_storage_size(42)
+ print *, 42*8
+end
diff --git a/flang/test/Semantics/call05.f90 b/flang/test/Semantics/call05.f90
index 269a0a3034a9f2b..66d0a375fa56de2 100644
--- a/flang/test/Semantics/call05.f90
+++ b/flang/test/Semantics/call05.f90
@@ -155,6 +155,15 @@ subroutine smb(b)
integer, allocatable, intent(in) :: b(:)
end
+ function return_deferred_length_ptr()
+ character(len=:), pointer :: return_deferred_length_ptr
+ end function
+
+ function return_explicit_length_ptr(n)
+ integer :: n
+ character(len=n), pointer :: return_explicit_length_ptr
+ end function
+
subroutine test()
!ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
@@ -167,6 +176,16 @@ subroutine test()
call smp2(p1) ! ok
+ call smp(return_deferred_length_ptr()) ! ok
+
+ !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
+ call smp2(return_deferred_length_ptr())
+
+ !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
+ call smp(return_explicit_length_ptr(10))
+
+ call smp2(return_explicit_length_ptr(10)) ! ok
+
!ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
call sma(t2(:))
>From 299d42d96e66481e2c0bff838506ed52828367c8 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Wed, 27 Sep 2023 10:41:36 -0700
Subject: [PATCH 2/2] address comments
---
flang/include/flang/Evaluate/call.h | 9 +++++++--
flang/include/flang/Evaluate/type.h | 5 +++--
flang/lib/Evaluate/type.cpp | 4 ++--
flang/test/Evaluate/rewrite06.f90 | 19 +++++++++++++++++++
4 files changed, 31 insertions(+), 6 deletions(-)
diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h
index 09673f00d7bddf4..d8241c08e3b25e3 100644
--- a/flang/include/flang/Evaluate/call.h
+++ b/flang/include/flang/Evaluate/call.h
@@ -269,8 +269,13 @@ template <typename A> class FunctionRef : public ProcedureRef {
: ProcedureRef{std::move(p), std::move(a)} {}
std::optional<DynamicType> GetType() const {
- if (auto type = proc_.GetType()) {
- return type->DropNonConstantParameters();
+ if (auto type{proc_.GetType()}) {
+ // TODO: Non constant explicit length parameters of PDTs result should
+ // likely be dropped too. This is not as easy as for characters since some
+ // long lived DerivedTypeSpec pointer would need to be created here. It is
+ // not clear if this is causing any issue so far since the storage size of
+ // PDTs is independent of length parameters.
+ return type->DropNonConstantCharacterLength();
}
return std::nullopt;
}
diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h
index 6baf9cf0259e33a..13060e42e47adbf 100644
--- a/flang/include/flang/Evaluate/type.h
+++ b/flang/include/flang/Evaluate/type.h
@@ -233,8 +233,9 @@ class DynamicType {
// Get a copy of this dynamic type where charLengthParamValue_ is reset if it
// is not a constant expression. This avoids propagating symbol references in
- // scopes where they do not belong.
- DynamicType DropNonConstantParameters() const;
+ // scopes where they do not belong. Returns the type unmodified if it is not
+ // a character or if the length is not explicit.
+ DynamicType DropNonConstantCharacterLength() const;
private:
// Special kind codes are used to distinguish the following Fortran types.
diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp
index cff265bcd1ff379..e5d9851e2496aeb 100644
--- a/flang/lib/Evaluate/type.cpp
+++ b/flang/lib/Evaluate/type.cpp
@@ -836,9 +836,9 @@ bool IsCUDAIntrinsicType(const DynamicType &type) {
}
}
-DynamicType DynamicType::DropNonConstantParameters() const {
+DynamicType DynamicType::DropNonConstantCharacterLength() const {
if (charLengthParamValue_ && charLengthParamValue_->isExplicit()) {
- if (std::optional<std::int64_t> len = knownLength()) {
+ if (std::optional<std::int64_t> len{knownLength()}) {
return DynamicType(kind_, *len);
} else {
return DynamicType(category_, kind_);
diff --git a/flang/test/Evaluate/rewrite06.f90 b/flang/test/Evaluate/rewrite06.f90
index 8f6aa200b4140dc..03eb463fe9bd5d4 100644
--- a/flang/test/Evaluate/rewrite06.f90
+++ b/flang/test/Evaluate/rewrite06.f90
@@ -12,3 +12,22 @@ function return_char(l)
!CHECK: PRINT *, sizeof(return_char(n))
print*, sizeof(return_char(n))
end subroutine
+
+module pdts
+ type t(l)
+ integer, len :: l
+ character(l) :: c
+ end type
+contains
+ function return_pdt(n)
+ type(t(n)) :: return_pdt
+ end function
+ subroutine test(k)
+ ! NOTE: flang design for length parametrized derived type
+ ! is to use allocatables for the automatic components. Hence,
+ ! their size is independent from the length parameters and is
+ ! a compile time constant.
+ !CHECK: PRINT *, 192_4
+ print *, storage_size(return_pdt(k))
+ end subroutine
+end module
More information about the flang-commits
mailing list