Skip to content

Commit b9031d3

Browse files
jeanPerierjeanPerier
committed
[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
1 parent 9dec07f commit b9031d3

File tree

3 files changed

+132
-3
lines changed

3 files changed

+132
-3
lines changed

‎flang/lib/Lower/ConvertVariable.cpp

Lines changed: 15 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -68,8 +68,21 @@ static bool hasDefaultInitialization(const Fortran::semantics::Symbol &sym) {
6868
if (!Fortran::semantics::IsAllocatableOrPointer(sym))
6969
if (const Fortran::semantics::DeclTypeSpec *declTypeSpec = sym.GetType())
7070
if (const Fortran::semantics::DerivedTypeSpec *derivedTypeSpec =
71-
declTypeSpec->AsDerived())
72-
return derivedTypeSpec->HasDefaultInitialization();
71+
declTypeSpec->AsDerived()) {
72+
// Pointer assignments in the runtime may hit undefined behaviors if
73+
// the RHS contains garbage. Pointer objects are always established by
74+
// lowering to NULL() (in Fortran::lower::createMutableBox). However,
75+
// pointer components need special care here so that local and global
76+
// derived type containing pointers are always initialized.
77+
// Intent(out), however, do not need to be initialized since the
78+
// related descriptor storage comes from a local or global that has
79+
// been initialized (it may not be NULL() anymore, but the rank, type,
80+
// and non deferred length parameters are still correct in a
81+
// conformant program, and that is what matters).
82+
const bool ignorePointer = Fortran::semantics::IsIntentOut(sym);
83+
return derivedTypeSpec->HasDefaultInitialization(
84+
/*ignoreAllocatable=*/false, ignorePointer);
85+
}
7386
return false;
7487
}
7588

‎flang/test/Lower/call-copy-in-out.f90

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -323,7 +323,7 @@ subroutine whole_component_contiguous_char_pointer()
323323
! CHECK: %[[a:.*]] = fir.alloca !fir.type<_QFwhole_component_contiguous_char_pointerTt{i:!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>}>
324324
type(t) :: a
325325
! CHECK: %[[field:.*]] = fir.field_index i, !fir.type<_QFwhole_component_contiguous_char_pointerTt{i:!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>}>
326-
! 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,?>>>>>
326+
! 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,?>>>>>
327327
! CHECK: %[[box_load:.*]] = fir.load %[[coor]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>
328328
! 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,?>>>
329329
! CHECK: %[[len:.*]] = fir.box_elesize %[[box_load]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> index

‎flang/test/Lower/pointer-default-init.f90

Lines changed: 116 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,116 @@
1+
! Test that pointer and pointer components are always initialized to a
2+
! clean NULL() status. This is required by f18 runtime to do pointer
3+
! association with a RHS with an undefined association status from a
4+
! Fortran point of view.
5+
! RUN: bbc -emit-fir -I nw %s -o - | FileCheck %s
6+
7+
module test
8+
type t
9+
integer :: i
10+
real, pointer :: x(:)
11+
end type
12+
13+
real, pointer :: test_module_pointer(:)
14+
! CHECK-LABEL: fir.global @_QMtestEtest_module_pointer : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
15+
! CHECK: %[[VAL_0:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
16+
! CHECK: %[[VAL_1:.*]] = arith.constant 0 : index
17+
! CHECK: %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
18+
! CHECK: %[[VAL_3:.*]] = fir.embox %[[VAL_0]](%[[VAL_2]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
19+
! CHECK: fir.has_value %[[VAL_3]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
20+
21+
type(t) :: test_module_var
22+
! CHECK-LABEL: fir.global @_QMtestEtest_module_var : !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> {
23+
! CHECK: %[[VAL_0:.*]] = fir.undefined !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>
24+
! CHECK: %[[VAL_1:.*]] = fir.undefined i32
25+
! CHECK: %[[VAL_2:.*]] = fir.field_index i
26+
! CHECK: %[[VAL_3:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_1]]
27+
! CHECK: %[[VAL_4:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
28+
! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index
29+
! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>
30+
! CHECK: %[[VAL_7:.*]] = fir.embox %[[VAL_4]](%[[VAL_6]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
31+
! CHECK: %[[VAL_8:.*]] = fir.field_index x
32+
! CHECK: %[[VAL_9:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_7]]
33+
! CHECK: fir.has_value %[[VAL_9]]
34+
end module
35+
36+
subroutine test_local()
37+
use test, only : t
38+
type(t) :: x
39+
end subroutine
40+
! CHECK-LABEL: func.func @_QPtest_local() {
41+
! CHECK: fir.call @_FortranAInitialize(
42+
43+
subroutine test_saved()
44+
use test, only : t
45+
type(t), save :: x
46+
end subroutine
47+
! See check for fir.global internal @_QFtest_savedEx below.
48+
49+
subroutine test_alloc(x)
50+
use test, only : t
51+
type(t), allocatable :: x
52+
allocate(x)
53+
end subroutine
54+
! CHECK-LABEL: func.func @_QPtest_alloc(
55+
! CHECK: fir.call @_FortranAAllocatableAllocate
56+
57+
subroutine test_intentout(x)
58+
use test, only : t
59+
type(t), intent(out):: x
60+
end subroutine
61+
! CHECK-LABEL: func.func @_QPtest_intentout(
62+
! CHECK-NOT: fir.call @_FortranAInitialize(
63+
! CHECK: return
64+
65+
subroutine test_struct_ctor_cst(x)
66+
use test, only : t
67+
type(t):: x
68+
x = t(42)
69+
end subroutine
70+
! CHECK-LABEL: func.func @_QPtest_struct_ctor_cst(
71+
! CHECK: fir.call @_FortranAInitialize(
72+
73+
subroutine test_struct_ctor_dyn(x, i)
74+
use test, only : t
75+
type(t):: x
76+
integer :: i
77+
x = t(i)
78+
end subroutine
79+
! CHECK-LABEL: func.func @_QPtest_struct_ctor_dyn(
80+
! CHECK: fir.call @_FortranAInitialize(
81+
82+
subroutine test_local_pointer()
83+
real, pointer :: x(:)
84+
end subroutine
85+
! CHECK-LABEL: func.func @_QPtest_local_pointer() {
86+
! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>> {bindc_name = "x", uniq_name = "_QFtest_local_pointerEx"}
87+
! CHECK: %[[VAL_1:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
88+
! CHECK: %[[VAL_2:.*]] = arith.constant 0 : index
89+
! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
90+
! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_1]](%[[VAL_3]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
91+
! CHECK: fir.store %[[VAL_4]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
92+
93+
subroutine test_saved_pointer()
94+
real, pointer, save :: x(:)
95+
end subroutine
96+
! See check for fir.global internal @_QFtest_saved_pointerEx below.
97+
98+
! CHECK-LABEL: fir.global internal @_QFtest_savedEx : !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> {
99+
! CHECK: %[[VAL_0:.*]] = fir.undefined !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>
100+
! CHECK: %[[VAL_1:.*]] = fir.undefined i32
101+
! CHECK: %[[VAL_2:.*]] = fir.field_index i
102+
! CHECK: %[[VAL_3:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_1]]
103+
! CHECK: %[[VAL_4:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
104+
! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index
105+
! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>
106+
! CHECK: %[[VAL_7:.*]] = fir.embox %[[VAL_4]](%[[VAL_6]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
107+
! CHECK: %[[VAL_8:.*]] = fir.field_index x
108+
! CHECK: %[[VAL_9:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_7]]
109+
! CHECK: fir.has_value %[[VAL_9]]
110+
111+
! CHECK-LABEL: fir.global internal @_QFtest_saved_pointerEx : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
112+
! CHECK: %[[VAL_0:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
113+
! CHECK: %[[VAL_1:.*]] = arith.constant 0 : index
114+
! CHECK: %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
115+
! CHECK: %[[VAL_3:.*]] = fir.embox %[[VAL_0]](%[[VAL_2]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
116+
! CHECK: fir.has_value %[[VAL_3]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>

0 commit comments

Comments
 (0)