diff --git a/flang/lib/Evaluate/formatting.cpp b/flang/lib/Evaluate/formatting.cpp index 062fec42d7fbe..e5b44779100e3 100644 --- a/flang/lib/Evaluate/formatting.cpp +++ b/flang/lib/Evaluate/formatting.cpp @@ -732,20 +732,23 @@ llvm::raw_ostream &DescriptorInquiry::AsFortran(llvm::raw_ostream &o) const { o << "%STRIDE("; break; case Field::Rank: - o << "rank("; + o << "int(rank("; break; case Field::Len: + o << "int("; break; } base_.AsFortran(o); if (field_ == Field::Len) { - return o << "%len"; + o << "%len"; + } else if (field_ == Field::Rank) { + o << ")"; } else { - if (field_ != Field::Rank && dimension_ >= 0) { + if (dimension_ >= 0) { o << ",dim=" << (dimension_ + 1); } - return o << ')'; } + return o << ",kind=" << DescriptorInquiry::Result::kind << ")"; } llvm::raw_ostream &Assignment::AsFortran(llvm::raw_ostream &o) const { diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp index 1a2f171e5ba86..0eefd935de801 100644 --- a/flang/lib/Evaluate/shape.cpp +++ b/flang/lib/Evaluate/shape.cpp @@ -244,7 +244,7 @@ class GetLowerBoundHelper return Result{1}; } - Result operator()(const Symbol &symbol0) const { + Result GetLowerBound(const Symbol &symbol0, NamedEntity &&base) const { const Symbol &symbol{symbol0.GetUltimate()}; if (const auto *details{ symbol.detailsIf()}) { @@ -301,7 +301,7 @@ class GetLowerBoundHelper } } if (IsDescriptor(symbol)) { - return ExtentExpr{DescriptorInquiry{NamedEntity{symbol0}, + return ExtentExpr{DescriptorInquiry{std::move(base), DescriptorInquiry::Field::LowerBound, dimension_}}; } } @@ -310,7 +310,7 @@ class GetLowerBoundHelper if (assoc->rank()) { // SELECT RANK case const Symbol &resolved{ResolveAssociations(symbol)}; if (IsDescriptor(resolved) && dimension_ < *assoc->rank()) { - return ExtentExpr{DescriptorInquiry{NamedEntity{symbol0}, + return ExtentExpr{DescriptorInquiry{std::move(base), DescriptorInquiry::Field::LowerBound, dimension_}}; } } else { @@ -324,9 +324,14 @@ class GetLowerBoundHelper } } + Result operator()(const Symbol &symbol0) const { + return GetLowerBound(symbol0, NamedEntity{symbol0}); + } + Result operator()(const Component &component) const { if (component.base().Rank() == 0) { - return (*this)(component.GetLastSymbol()); + return GetLowerBound( + component.GetLastSymbol(), NamedEntity{common::Clone(component)}); } return Result{1}; } diff --git a/flang/test/Evaluate/rewrite01.f90 b/flang/test/Evaluate/rewrite01.f90 index a752905856511..6b8b34dc523bc 100644 --- a/flang/test/Evaluate/rewrite01.f90 +++ b/flang/test/Evaluate/rewrite01.f90 @@ -26,7 +26,7 @@ function returns_array_3() subroutine ubound_test(x, n, m) integer :: x(n, m) integer :: y(0:n, 0:m) ! UBOUND could be 0 if n or m are < 0 - !CHECK: PRINT *, [INTEGER(4)::int(size(x,dim=1),kind=4),int(size(x,dim=2),kind=4)] + !CHECK: PRINT *, [INTEGER(4)::int(size(x,dim=1,kind=8),kind=4),int(size(x,dim=2,kind=8),kind=4)] print *, ubound(x) !CHECK: PRINT *, ubound(returns_array(n,m)) print *, ubound(returns_array(n, m)) @@ -44,7 +44,7 @@ subroutine ubound_test(x, n, m) subroutine size_test(x, n, m) integer :: x(n, m) - !CHECK: PRINT *, int(size(x,dim=1)*size(x,dim=2),kind=4) + !CHECK: PRINT *, int(size(x,dim=1,kind=8)*size(x,dim=2,kind=8),kind=4) print *, size(x) !CHECK: PRINT *, size(returns_array(n,m)) print *, size(returns_array(n, m)) @@ -58,7 +58,7 @@ subroutine size_test(x, n, m) subroutine shape_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)] + !CHECK: PRINT *, [INTEGER(4)::int(size(x,dim=1,kind=8),kind=4),int(size(x,dim=2,kind=8),kind=4)] print *, shape(x) !CHECK: PRINT *, shape(returns_array(n,m)) print *, shape(returns_array(n, m)) @@ -71,6 +71,10 @@ subroutine shape_test(x, n, m) subroutine lbound_test(x, n, m) integer :: x(n, m) integer :: y(0:n, 0:m) ! LBOUND could be 1 if n or m are < 0 + type t + real, pointer :: p(:, :) + end type + type(t) :: a(10) !CHECK: PRINT *, [INTEGER(4)::1_4,1_4] print *, lbound(x) !CHECK: PRINT *, [INTEGER(4)::1_4,1_4] @@ -85,6 +89,8 @@ subroutine lbound_test(x, n, m) print *, lbound(y) !CHECK: PRINT *, lbound(y,1_4) print *, lbound(y, 1) + !CHECK: PRINT *, lbound(a(1_8)%p,dim=1,kind=8) + print *, lbound(a(1)%p, 1, kind=8) end subroutine !CHECK: len_test @@ -98,8 +104,8 @@ subroutine len_test(a,b, c, d, e, n, m) integer, intent(in) :: n, m character(n), intent(in) :: e - !CHECK: PRINT *, int(a%len,kind=4) - print *, len(a) + !CHECK: PRINT *, int(a%len,kind=8) + print *, len(a, kind=8) !CHECK: PRINT *, 5_4 print *, len(a(1:5)) !CHECK: PRINT *, len(b(a)) diff --git a/flang/test/Semantics/modfile30.f90 b/flang/test/Semantics/modfile30.f90 index ce40e199af43d..9c3fffb15f7cf 100644 --- a/flang/test/Semantics/modfile30.f90 +++ b/flang/test/Semantics/modfile30.f90 @@ -19,11 +19,11 @@ function f2(x) !contains ! function f1(x) result(y) ! integer(4)::x(:) -! integer(4)::y(1_8:size(x,dim=1)) +! integer(4)::y(1_8:size(x,dim=1,kind=8)) ! end ! function f2(x) ! integer(4)::x(:) -! integer(4)::f2(1_8:size(x,dim=1)) +! integer(4)::f2(1_8:size(x,dim=1,kind=8)) ! end !end diff --git a/flang/test/Semantics/modfile33.f90 b/flang/test/Semantics/modfile33.f90 index 5eae92a8a7f99..6aad8b2937b61 100644 --- a/flang/test/Semantics/modfile33.f90 +++ b/flang/test/Semantics/modfile33.f90 @@ -572,7 +572,7 @@ subroutine s1(n, x, y, z, a, b) ! real(4) :: x ! real(4) :: y(1_8:4_8, 1_8:n) ! real(4) :: z(1_8:2_8, 1_8:2_8, 1_8:2_8) -! real(4) :: a(1_8:int(int(4_8*size(y,dim=2),kind=4),kind=8)) +! real(4) :: a(1_8:int(int(4_8*size(y,dim=2,kind=8),kind=4),kind=8)) ! real(4) :: b(1_8:add(y, z)) ! end !end