[flang-commits] [flang] b9031d3 - [flang] Ensure pointer components are always established
Jean Perier via flang-commits
flang-commits at lists.llvm.org
Tue May 9 09:26:55 PDT 2023
Author: Jean Perier
Date: 2023-05-09T18:26:21+02:00
New Revision: b9031d327929c160293f38b0afbf7facec0f591c
URL: https://github.com/llvm/llvm-project/commit/b9031d327929c160293f38b0afbf7facec0f591c
DIFF: https://github.com/llvm/llvm-project/commit/b9031d327929c160293f38b0afbf7facec0f591c.diff
LOG: [flang] Ensure pointer components are always established
Follow up of https://reviews.llvm.org/D149979 for lowering.
In Fortran, it is possible to assign a pointer to another pointer
with an undefined association status.
When using the runtime do to none trivial pointer association, if the
descriptor are garbage, the runtime cannot safely detect that it has
a garbage descriptor, and it cannot safely know the descriptor size
leading to undefined behavior.
Another reason to initialize descriptor of pointers is to record any
non deferred length parameter value.
Hence, although this is not required by Fortran, f18 always initialize
pointers to NULL().
This was already done in lowering for whole pointer object, but not for
pointer components.
This patch uses the related semantics patch that updated
derivedTypeSpe::HasDefaultInitialization to ensure pointer components
of local and global object are always initialized.
It adds tests to ensure that allocation of such derived type uses the
runtime to ensure the storage is initialized, and that structure
constructors are setting the descriptor component to NULL() if no
initial target is given.
Differential Revision: https://reviews.llvm.org/D150180
Added:
flang/test/Lower/pointer-default-init.f90
Modified:
flang/lib/Lower/ConvertVariable.cpp
flang/test/Lower/call-copy-in-out.f90
Removed:
################################################################################
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index c0343356a84a..2204505571ce 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -68,8 +68,21 @@ static bool hasDefaultInitialization(const Fortran::semantics::Symbol &sym) {
if (!Fortran::semantics::IsAllocatableOrPointer(sym))
if (const Fortran::semantics::DeclTypeSpec *declTypeSpec = sym.GetType())
if (const Fortran::semantics::DerivedTypeSpec *derivedTypeSpec =
- declTypeSpec->AsDerived())
- return derivedTypeSpec->HasDefaultInitialization();
+ declTypeSpec->AsDerived()) {
+ // Pointer assignments in the runtime may hit undefined behaviors if
+ // the RHS contains garbage. Pointer objects are always established by
+ // lowering to NULL() (in Fortran::lower::createMutableBox). However,
+ // pointer components need special care here so that local and global
+ // derived type containing pointers are always initialized.
+ // Intent(out), however, do not need to be initialized since the
+ // related descriptor storage comes from a local or global that has
+ // been initialized (it may not be NULL() anymore, but the rank, type,
+ // and non deferred length parameters are still correct in a
+ // conformant program, and that is what matters).
+ const bool ignorePointer = Fortran::semantics::IsIntentOut(sym);
+ return derivedTypeSpec->HasDefaultInitialization(
+ /*ignoreAllocatable=*/false, ignorePointer);
+ }
return false;
}
diff --git a/flang/test/Lower/call-copy-in-out.f90 b/flang/test/Lower/call-copy-in-out.f90
index fcf0abc41183..d6e21c73e3b7 100644
--- a/flang/test/Lower/call-copy-in-out.f90
+++ b/flang/test/Lower/call-copy-in-out.f90
@@ -323,7 +323,7 @@ subroutine whole_component_contiguous_char_pointer()
! CHECK: %[[a:.*]] = fir.alloca !fir.type<_QFwhole_component_contiguous_char_pointerTt{i:!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>}>
type(t) :: a
! CHECK: %[[field:.*]] = fir.field_index i, !fir.type<_QFwhole_component_contiguous_char_pointerTt{i:!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>}>
- ! CHECK: %[[coor:.*]] = fir.coordinate_of %0, %1 : (!fir.ref<!fir.type<_QFwhole_component_contiguous_char_pointerTt{i:!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>
+ ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a]], %[[field]] : (!fir.ref<!fir.type<_QFwhole_component_contiguous_char_pointerTt{i:!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>
! CHECK: %[[box_load:.*]] = fir.load %[[coor]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>
! CHECK: %[[addr:.*]] = fir.box_addr %[[box_load]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> !fir.ptr<!fir.array<?x!fir.char<1,?>>>
! CHECK: %[[len:.*]] = fir.box_elesize %[[box_load]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> index
diff --git a/flang/test/Lower/pointer-default-init.f90 b/flang/test/Lower/pointer-default-init.f90
new file mode 100644
index 000000000000..4697d601347e
--- /dev/null
+++ b/flang/test/Lower/pointer-default-init.f90
@@ -0,0 +1,116 @@
+! Test that pointer and pointer components are always initialized to a
+! clean NULL() status. This is required by f18 runtime to do pointer
+! association with a RHS with an undefined association status from a
+! Fortran point of view.
+! RUN: bbc -emit-fir -I nw %s -o - | FileCheck %s
+
+module test
+ type t
+ integer :: i
+ real, pointer :: x(:)
+ end type
+
+ real, pointer :: test_module_pointer(:)
+! CHECK-LABEL: fir.global @_QMtestEtest_module_pointer : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
+! CHECK: %[[VAL_0:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
+! CHECK: %[[VAL_1:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_3:.*]] = fir.embox %[[VAL_0]](%[[VAL_2]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+! CHECK: fir.has_value %[[VAL_3]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
+
+ type(t) :: test_module_var
+! CHECK-LABEL: fir.global @_QMtestEtest_module_var : !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> {
+! CHECK: %[[VAL_0:.*]] = fir.undefined !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>
+! CHECK: %[[VAL_1:.*]] = fir.undefined i32
+! CHECK: %[[VAL_2:.*]] = fir.field_index i
+! CHECK: %[[VAL_3:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_1]]
+! CHECK: %[[VAL_4:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
+! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_7:.*]] = fir.embox %[[VAL_4]](%[[VAL_6]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+! CHECK: %[[VAL_8:.*]] = fir.field_index x
+! CHECK: %[[VAL_9:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_7]]
+! CHECK: fir.has_value %[[VAL_9]]
+end module
+
+subroutine test_local()
+ use test, only : t
+ type(t) :: x
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_local() {
+! CHECK: fir.call @_FortranAInitialize(
+
+subroutine test_saved()
+ use test, only : t
+ type(t), save :: x
+end subroutine
+! See check for fir.global internal @_QFtest_savedEx below.
+
+subroutine test_alloc(x)
+ use test, only : t
+ type(t), allocatable :: x
+ allocate(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_alloc(
+! CHECK: fir.call @_FortranAAllocatableAllocate
+
+subroutine test_intentout(x)
+ use test, only : t
+ type(t), intent(out):: x
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_intentout(
+! CHECK-NOT: fir.call @_FortranAInitialize(
+! CHECK: return
+
+subroutine test_struct_ctor_cst(x)
+ use test, only : t
+ type(t):: x
+ x = t(42)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_struct_ctor_cst(
+! CHECK: fir.call @_FortranAInitialize(
+
+subroutine test_struct_ctor_dyn(x, i)
+ use test, only : t
+ type(t):: x
+ integer :: i
+ x = t(i)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_struct_ctor_dyn(
+! CHECK: fir.call @_FortranAInitialize(
+
+subroutine test_local_pointer()
+ real, pointer :: x(:)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_local_pointer() {
+! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>> {bindc_name = "x", uniq_name = "_QFtest_local_pointerEx"}
+! CHECK: %[[VAL_1:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
+! CHECK: %[[VAL_2:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_1]](%[[VAL_3]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+! CHECK: fir.store %[[VAL_4]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+
+subroutine test_saved_pointer()
+ real, pointer, save :: x(:)
+end subroutine
+! See check for fir.global internal @_QFtest_saved_pointerEx below.
+
+! CHECK-LABEL: fir.global internal @_QFtest_savedEx : !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> {
+! CHECK: %[[VAL_0:.*]] = fir.undefined !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>
+! CHECK: %[[VAL_1:.*]] = fir.undefined i32
+! CHECK: %[[VAL_2:.*]] = fir.field_index i
+! CHECK: %[[VAL_3:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_1]]
+! CHECK: %[[VAL_4:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
+! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_7:.*]] = fir.embox %[[VAL_4]](%[[VAL_6]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+! CHECK: %[[VAL_8:.*]] = fir.field_index x
+! CHECK: %[[VAL_9:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_7]]
+! CHECK: fir.has_value %[[VAL_9]]
+
+! CHECK-LABEL: fir.global internal @_QFtest_saved_pointerEx : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
+! CHECK: %[[VAL_0:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
+! CHECK: %[[VAL_1:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_3:.*]] = fir.embox %[[VAL_0]](%[[VAL_2]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+! CHECK: fir.has_value %[[VAL_3]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
More information about the flang-commits
mailing list