[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

Author: jeanPerier

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 {

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};
   }

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))

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
 

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