if (subp.isFunction()) {
auto resultShape{(*this)(subp.result())};
if (resultShape && !useResultSymbolShape_) {
- // Ensure the shape does not contain descriptor inquiries, they
- // may refer to symbols belonging to the called subprogram scope
- // that are meaningless on the caller side without the related
- // call expression.
+ // Ensure the shape is constant. Otherwise, it may be referring
+ // to symbols that belong to the subroutine scope and are
+ // meaningless on the caller side without the related call
+ // expression.
for (auto extent : *resultShape) {
- if (extent &&
- std::holds_alternative<DescriptorInquiry>(extent->u)) {
+ if (extent && !IsConstantExpr(*extent)) {
return std::nullopt;
}
}
returns_array = 0
end function
+function returns_array_2(n)
+ integer, intent(in) :: n
+ integer :: returns_array_2(n)
+ returns_array_2 = 0
+end function
+
+function returns_array_3()
+ integer :: returns_array_3(7:46+2)
+ returns_array_3 = 0
+end function
+
subroutine ubound_test(x, n, m)
integer :: x(n, m)
!CHECK: PRINT *, [INTEGER(4)::int(size(x,dim=1),kind=4),int(size(x,dim=2),kind=4)]
print *, ubound(returns_array(n, m))
!CHECK: PRINT *, ubound(returns_array(n,m),dim=1_4)
print *, ubound(returns_array(n, m), dim=1)
+ !CHECK: PRINT *, ubound(returns_array_2(m))
+ print *, ubound(returns_array_2(m))
+ !CHECK: PRINT *, 42_8
+ print *, ubound(returns_array_3(), dim=1, kind=8)
end subroutine
subroutine size_test(x, n, m)
print *, size(returns_array(n, m))
!CHECK: PRINT *, size(returns_array(n,m),dim=1_4)
print *, size(returns_array(n, m), dim=1)
+ !CHECK: PRINT *, size(returns_array_2(m))
+ print *, size(returns_array_2(m))
+ !CHECK: PRINT *, 42_8
+ print *, size(returns_array_3(), kind=8)
end subroutine
subroutine shape_test(x, n, m)
print *, shape(x)
!CHECK: PRINT *, shape(returns_array(n,m))
print *, shape(returns_array(n, m))
+ !CHECK: PRINT *, shape(returns_array_2(m))
+ print *, shape(returns_array_2(m))
+ !CHECK: PRINT *, [INTEGER(8)::42_8]
+ print *, shape(returns_array_3(), kind=8)
end subroutine
subroutine lbound_test(x, n, m)
print *, lbound(returns_array(n, m))
!CHECK: PRINT *, 1_4
print *, lbound(returns_array(n, m), dim=1)
+ !CHECK: PRINT *, 1_4
+ print *, lbound(returns_array_2(m), dim=1)
+ !CHECK: PRINT *, 1_4
+ print *, lbound(returns_array_3(), dim=1)
end subroutine
end module