Skip to content

Commit 2233dbf

Browse files
jeanPerierjeanPerier
committed
Handle negative allocatable and pointer explicit length
Fortran 2018 7.4.4.2 point 5 specifies the character length is zero if the explicit length that is negative. This was not applied to allocatable/pointer entities with non-deferred length, causing potential crashes in valid programs. Ensure the max(0, spec expr) is used for the pointer/allocatable length too.
1 parent f70a1fa commit 2233dbf

File tree

6 files changed

+81
-23
lines changed

6 files changed

+81
-23
lines changed

‎flang/lib/Lower/ConvertVariable.cpp‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1121,7 +1121,11 @@ lowerExplicitCharLen(Fortran::lower::AbstractConverter &converter,
11211121
if (llvm::Optional<int64_t> len = box.getCharLenConst())
11221122
return builder.createIntegerConstant(loc, lenTy, *len);
11231123
if (llvm::Optional<Fortran::lower::SomeExpr> lenExpr = box.getCharLenExpr())
1124-
return genScalarValue(converter, loc, *lenExpr, symMap, stmtCtx);
1124+
// If the length expression is negative, the length is zero. See F2018
1125+
// 7.4.4.2 point 5.
1126+
return Fortran::lower::genMaxWithZero(
1127+
builder, loc,
1128+
genScalarValue(converter, loc, *lenExpr, symMap, stmtCtx));
11251129
return mlir::Value{};
11261130
}
11271131

‎flang/test/Lower/allocatable-assignment.f90‎

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -177,7 +177,10 @@ subroutine test_cst_char_scalar(x)
177177
subroutine test_dyn_char_scalar(x, n)
178178
integer :: n
179179
character(n), allocatable :: x
180-
! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]] : !fir.ref<i32>
180+
! CHECK: %[[VAL_2A:.*]] = fir.load %[[VAL_1]] : !fir.ref<i32>
181+
! CHECK: %[[c0_i32:.*]] = arith.constant 0 : i32
182+
! CHECK: %[[VAL_2B:.*]] = arith.cmpi sgt, %[[VAL_2A]], %[[c0_i32]] : i32
183+
! CHECK: %[[VAL_2:.*]] = select %[[VAL_2B]], %[[VAL_2A]], %[[c0_i32]] : i32
181184
! CHECK: %[[VAL_3:.*]] = fir.address_of(@_QQcl.48656C6C6F20776F726C6421) : !fir.ref<!fir.char<1,12>>
182185
! CHECK: %[[VAL_4:.*]] = arith.constant 12 : index
183186
! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
@@ -617,7 +620,10 @@ subroutine test_dyn_char(x, n, c)
617620
! CHECK: %[[VAL_3:.*]]:2 = fir.unboxchar %[[VAL_2]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
618621
! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<20x!fir.char<1,?>>>
619622
! CHECK: %[[VAL_5_0:.*]] = arith.constant 20 : index
620-
! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_1]] : !fir.ref<i32>
623+
! CHECK: %[[VAL_6A:.*]] = fir.load %[[VAL_1]] : !fir.ref<i32>
624+
! CHECK: %[[c0_i32:.*]] = arith.constant 0 : i32
625+
! CHECK: %[[VAL_6B:.*]] = arith.cmpi sgt, %[[VAL_6A]], %[[c0_i32]] : i32
626+
! CHECK: %[[VAL_6:.*]] = select %[[VAL_6B]], %[[VAL_6A]], %[[c0_i32]] : i32
621627
! CHECK: %[[VAL_5:.*]] = arith.constant 20 : index
622628
! CHECK: %[[VAL_7:.*]] = fir.shape %[[VAL_5_0]] : (index) -> !fir.shape<1>
623629
! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>

‎flang/test/Lower/allocatable-callee.f90‎

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -59,7 +59,10 @@ subroutine test_char_scalar_explicit_dynamic(c, n)
5959
character(n), allocatable :: c
6060
external foo1
6161
! Check that the length expr was evaluated before the execution parts.
62-
! CHECK: %[[len:.*]] = fir.load %arg1 : !fir.ref<i32>
62+
! CHECK: %[[raw_len:.*]] = fir.load %arg1 : !fir.ref<i32>
63+
! CHECK: %[[c0_i32:.*]] = arith.constant 0 : i32
64+
! CHECK: %[[cmp:.*]] = arith.cmpi sgt, %[[raw_len]], %[[c0_i32]] : i32
65+
! CHECK: %[[len:.*]] = select %[[cmp]], %[[raw_len]], %[[c0_i32]] : i32
6366
n = n + 1
6467
! CHECK: fir.store {{.*}} to %arg1 : !fir.ref<i32>
6568
call foo1(c)
@@ -106,7 +109,10 @@ subroutine test_char_array_explicit_dynamic(c, n)
106109
character(n), allocatable :: c(:)
107110
external foo1
108111
! Check that the length expr was evaluated before the execution parts.
109-
! CHECK: %[[len:.*]] = fir.load %arg1 : !fir.ref<i32>
112+
! CHECK: %[[raw_len:.*]] = fir.load %arg1 : !fir.ref<i32>
113+
! CHECK: %[[c0_i32:.*]] = arith.constant 0 : i32
114+
! CHECK: %[[cmp:.*]] = arith.cmpi sgt, %[[raw_len]], %[[c0_i32]] : i32
115+
! CHECK: %[[len:.*]] = select %[[cmp]], %[[raw_len]], %[[c0_i32]] : i32
110116
n = n + 1
111117
! CHECK: fir.store {{.*}} to %arg1 : !fir.ref<i32>
112118
call foo1(c(1))

‎flang/test/Lower/allocatable-runtime.f90‎

Lines changed: 21 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -135,25 +135,31 @@ subroutine char_explicit_cst(n)
135135
subroutine char_explicit_dyn(n, l1, l2)
136136
integer :: n, l1, l2
137137
character(l1), allocatable :: scalar
138-
! CHECK-DAG: %[[l1:.*]] = fir.load %arg1 : !fir.ref<i32>
139-
! CHECK-DAG: %[[sBoxAddr:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>> {{{.*}}uniq_name = "_QFchar_explicit_dynEscalar"}
140-
! CHECK-DAG: %[[sNullAddr:.*]] = fir.zero_bits !fir.heap<!fir.char<1,?>>
141-
! CHECK-DAG: %[[sInitBox:.*]] = fir.embox %[[sNullAddr]] typeparams %[[l1]] : (!fir.heap<!fir.char<1,?>>, i32) -> !fir.box<!fir.heap<!fir.char<1,?>>>
142-
! CHECK-DAG: fir.store %[[sInitBox]] to %[[sBoxAddr]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
143-
144-
character(l2), allocatable :: array(:)
145-
! CHECK-DAG: %[[l2:.*]] = fir.load %arg2 : !fir.ref<i32>
146-
! CHECK-DAG: %[[aBoxAddr:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>> {{{.*}}uniq_name = "_QFchar_explicit_dynEarray"}
147-
! CHECK-DAG: %[[aNullAddr:.*]] = fir.zero_bits !fir.heap<!fir.array<?x!fir.char<1,?>>>
148-
! CHECK-DAG: %[[aNullShape:.*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1>
149-
! CHECK-DAG: %[[aInitBox:.*]] = fir.embox %[[aNullAddr]](%[[aNullShape]]) typeparams %[[l2]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, i32) -> !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>
150-
! CHECK-DAG: fir.store %[[aInitBox]] to %[[aBoxAddr]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
151-
allocate(scalar, array(20))
138+
! CHECK: %[[sBoxAddr:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>> {{{.*}}uniq_name = "_QFchar_explicit_dynEscalar"}
139+
! CHECK: %[[raw_l1:.*]] = fir.load %arg1 : !fir.ref<i32>
140+
! CHECK: %[[c0_i32:.*]] = arith.constant 0 : i32
141+
! CHECK: %[[cmp1:.*]] = arith.cmpi sgt, %[[raw_l1]], %[[c0_i32]] : i32
142+
! CHECK: %[[l1:.*]] = select %[[cmp1]], %[[raw_l1]], %[[c0_i32]] : i32
143+
! CHECK: %[[sNullAddr:.*]] = fir.zero_bits !fir.heap<!fir.char<1,?>>
144+
! CHECK: %[[sInitBox:.*]] = fir.embox %[[sNullAddr]] typeparams %[[l1]] : (!fir.heap<!fir.char<1,?>>, i32) -> !fir.box<!fir.heap<!fir.char<1,?>>>
145+
! CHECK: fir.store %[[sInitBox]] to %[[sBoxAddr]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
146+
147+
character(l2), allocatable :: zarray(:)
148+
! CHECK: %[[aBoxAddr:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>> {{{.*}}uniq_name = "_QFchar_explicit_dynEzarray"}
149+
! CHECK: %[[raw_l2:.*]] = fir.load %arg2 : !fir.ref<i32>
150+
! CHECK: %[[c0_i32_2:.*]] = arith.constant 0 : i32
151+
! CHECK: %[[cmp2:.*]] = arith.cmpi sgt, %[[raw_l2]], %[[c0_i32_2]] : i32
152+
! CHECK: %[[l2:.*]] = select %[[cmp2]], %[[raw_l2]], %[[c0_i32_2]] : i32
153+
! CHECK: %[[aNullAddr:.*]] = fir.zero_bits !fir.heap<!fir.array<?x!fir.char<1,?>>>
154+
! CHECK: %[[aNullShape:.*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1>
155+
! CHECK: %[[aInitBox:.*]] = fir.embox %[[aNullAddr]](%[[aNullShape]]) typeparams %[[l2]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, i32) -> !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>
156+
! CHECK: fir.store %[[aInitBox]] to %[[aBoxAddr]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
157+
allocate(scalar, zarray(20))
152158
! CHECK-NOT: AllocatableInitCharacter
153159
! CHECK: AllocatableAllocate
154160
! CHECK-NOT: AllocatableInitCharacter
155161
! CHECK: AllocatableAllocate
156-
deallocate(scalar, array)
162+
deallocate(scalar, zarray)
157163
! CHECK: AllocatableDeallocate
158164
! CHECK: AllocatableDeallocate
159165
end subroutine

‎flang/test/Lower/allocatables.f90‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -124,8 +124,11 @@ subroutine char_explicit_cst(n)
124124
subroutine char_explicit_dyn(l1, l2)
125125
integer :: l1, l2
126126
character(l1), allocatable :: c
127-
! CHECK-DAG: %[[cLen:.*]] = fir.load %arg0 : !fir.ref<i32>
128-
! CHECK-DAG: %[[cAddrVar:.*]] = fir.alloca !fir.heap<!fir.char<1,?>> {{{.*}}uniq_name = "_QFchar_explicit_dynEc.addr"}
127+
! CHECK: %[[l1:.*]] = fir.load %arg0 : !fir.ref<i32>
128+
! CHECK: %[[c0_i32:.*]] = arith.constant 0 : i32
129+
! CHECK: %[[cmp:.*]] = arith.cmpi sgt, %[[l1]], %[[c0_i32]] : i32
130+
! CHECK: %[[cLen:.*]] = select %[[cmp]], %[[l1]], %[[c0_i32]] : i32
131+
! CHECK: %[[cAddrVar:.*]] = fir.alloca !fir.heap<!fir.char<1,?>> {{{.*}}uniq_name = "_QFchar_explicit_dynEc.addr"}
129132
! CHECK-NOT: "_QFchar_explicit_dynEc.len"
130133
allocate(c)
131134
! CHECK: %[[cLenCast1:.*]] = fir.convert %[[cLen]] : (i32) -> index

‎flang/test/Lower/intrinsic-procedures/len.f90‎

Lines changed: 34 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -71,6 +71,39 @@ subroutine len_test_alloc_explicit_len(i, n, c)
7171
integer :: n
7272
character(n), allocatable :: c(:)
7373
! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_1]] : !fir.ref<i32>
74-
! CHECK: fir.store %[[VAL_3]] to %[[VAL_0]] : !fir.ref<i32>
74+
! CHECK: %[[c0_i32:.*]] = arith.constant 0 : i32
75+
! CHECK: %[[cmp:.*]] = arith.cmpi sgt, %[[VAL_3]], %[[c0_i32]] : i32
76+
! CHECK: %[[len:.*]] = select %[[cmp]], %[[VAL_3]], %[[c0_i32]] : i32
77+
! CHECK: fir.store %[[len]] to %[[VAL_0]] : !fir.ref<i32>
78+
i = len(c)
79+
end subroutine
80+
81+
! CHECK-LABEL: func @_QPlen_test_pointer_explicit_len(
82+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "i"},
83+
! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<i32> {fir.bindc_name = "n"},
84+
subroutine len_test_pointer_explicit_len(i, n, c)
85+
integer :: i
86+
integer :: n
87+
character(n), pointer :: c(:)
88+
! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_1]] : !fir.ref<i32>
89+
! CHECK: %[[c0_i32:.*]] = arith.constant 0 : i32
90+
! CHECK: %[[cmp:.*]] = arith.cmpi sgt, %[[VAL_3]], %[[c0_i32]] : i32
91+
! CHECK: %[[len:.*]] = select %[[cmp]], %[[VAL_3]], %[[c0_i32]] : i32
92+
! CHECK: fir.store %[[len]] to %[[VAL_0]] : !fir.ref<i32>
93+
i = len(c)
94+
end subroutine
95+
96+
! CHECK-LABEL: func @_QPlen_test_assumed_shape_explicit_len(
97+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "i"},
98+
! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<i32> {fir.bindc_name = "n"},
99+
subroutine len_test_assumed_shape_explicit_len(i, n, c)
100+
integer :: i
101+
integer :: n
102+
character(n) :: c(:)
103+
! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_1]] : !fir.ref<i32>
104+
! CHECK: %[[c0_i32:.*]] = arith.constant 0 : i32
105+
! CHECK: %[[cmp:.*]] = arith.cmpi sgt, %[[VAL_3]], %[[c0_i32]] : i32
106+
! CHECK: %[[len:.*]] = select %[[cmp]], %[[VAL_3]], %[[c0_i32]] : i32
107+
! CHECK: fir.store %[[len]] to %[[VAL_0]] : !fir.ref<i32>
75108
i = len(c)
76109
end subroutine

0 commit comments

Comments
 (0)