[flang-commits] [flang] 8c12707 - [flang] Fix issues with STORAGE_SIZE and characters (#67561)
via flang-commits
flang-commits at lists.llvm.org
Wed Sep 27 23:59:48 PDT 2023
Author: jeanPerier
Date: 2023-09-28T08:59:44+02:00
New Revision: 8c1270740f6bf659e5fbf556c1145ddaa7aa5366
URL: https://github.com/llvm/llvm-project/commit/8c1270740f6bf659e5fbf556c1145ddaa7aa5366
DIFF: https://github.com/llvm/llvm-project/commit/8c1270740f6bf659e5fbf556c1145ddaa7aa5366.diff
LOG: [flang] Fix issues with STORAGE_SIZE and characters (#67561)
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).
Added:
flang/test/Evaluate/rewrite06.f90
flang/test/Lower/Intrinsics/storage_size-2.f90
Modified:
flang/include/flang/Evaluate/call.h
flang/include/flang/Evaluate/type.h
flang/lib/Evaluate/type.cpp
flang/lib/Optimizer/Builder/IntrinsicCall.cpp
flang/test/Semantics/call05.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h
index f2c231647390bde..d8241c08e3b25e3 100644
--- a/flang/include/flang/Evaluate/call.h
+++ b/flang/include/flang/Evaluate/call.h
@@ -268,7 +268,17 @@ 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()}) {
+ // 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;
+ }
};
} // 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..13060e42e47adbf 100644
--- a/flang/include/flang/Evaluate/type.h
+++ b/flang/include/flang/Evaluate/type.h
@@ -231,6 +231,12 @@ 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. 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.
enum SpecialKind {
diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp
index 1497c037d9cc6e3..e5d9851e2496aeb 100644
--- a/flang/lib/Evaluate/type.cpp
+++ b/flang/lib/Evaluate/type.cpp
@@ -836,4 +836,15 @@ bool IsCUDAIntrinsicType(const DynamicType &type) {
}
}
+DynamicType DynamicType::DropNonConstantCharacterLength() 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..03eb463fe9bd5d4
--- /dev/null
+++ b/flang/test/Evaluate/rewrite06.f90
@@ -0,0 +1,33 @@
+! 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
+
+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
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(:))
More information about the flang-commits
mailing list