[flang-commits] [flang] 7f1adba - [flang] Fix LBOUND rewrite on descriptor components
Jean Perier via flang-commits
flang-commits at lists.llvm.org
Fri Mar 25 01:02:26 PDT 2022
Author: Jean Perier
Date: 2022-03-25T09:00:56+01:00
New Revision: 7f1adbaba99512d5fbf45ec54585b41218535836
URL: https://github.com/llvm/llvm-project/commit/7f1adbaba99512d5fbf45ec54585b41218535836
DIFF: https://github.com/llvm/llvm-project/commit/7f1adbaba99512d5fbf45ec54585b41218535836.diff
LOG: [flang] Fix LBOUND rewrite on descriptor components
GetLowerBoundHelper rewrite in https://reviews.llvm.org/D121488 was
incorrect with POINTER/ALLOCATABLE components. The rewrite created a
descriptor inquiry to the component symbol only instead of the whole
named entity. The base information was lost, and not retrievable.
LBOUND(a(10)%p) became LBOUND(p).
Fix this regression, and also update DescriptorInquiry unparsing to
carry the kind information. DescriptorInquiries are KIND 8 expressions,
while LBOUND/SIZE/RANK, %LEN are default kind expressions.
This caused `print *,lbound(x,kind=8)` to unparse as `print*,lbound(x)` which is not
semantically the same (this unparsing issue was not an issue for
lowering, but I noticed it while writing my regression test).
Differential Revision: https://reviews.llvm.org/D122406
Added:
Modified:
flang/lib/Evaluate/formatting.cpp
flang/lib/Evaluate/shape.cpp
flang/test/Evaluate/rewrite01.f90
flang/test/Semantics/modfile30.f90
flang/test/Semantics/modfile33.f90
Removed:
################################################################################
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<semantics::ObjectEntityDetails>()}) {
@@ -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
More information about the flang-commits
mailing list