[flang-commits] [flang] [flang] Implement rank-1 integer array as bound expressions in ALLOCATE statements (PR #178089)

[via flang-commits]

================
@@ -416,29 +435,144 @@ class AllocateStmtHelper {
     mlir::Type idxTy = builder.getIndexType();
     bool lBoundsAreOnes = lowerBoundsAreOnes(alloc);
     mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
-    for (const Fortran::parser::AllocateShapeSpec &shapeSpec :
-         alloc.getShapeSpecs()) {
-      mlir::Value lb;
-      if (!lBoundsAreOnes) {
-        if (const std::optional<Fortran::parser::BoundExpr> &lbExpr =
-                std::get<0>(shapeSpec.t)) {
-          lb = fir::getBase(converter.genExprValue(
-              loc, Fortran::semantics::GetExpr(*lbExpr), stmtCtx));
-          lb = builder.createConvert(loc, idxTy, lb);
+    if(!alloc.hasArrayBounds()) {
+      for (const Fortran::parser::AllocateShapeSpec &shapeSpec :
+          alloc.getShapeSpecs()) {
+        mlir::Value lb;
+        if (!lBoundsAreOnes) {
+          if (const std::optional<Fortran::parser::BoundExpr> &lbExpr =
+                  std::get<0>(shapeSpec.t)) {
+            lb = fir::getBase(converter.genExprValue(
+                loc, Fortran::semantics::GetExpr(*lbExpr), stmtCtx));
+            lb = builder.createConvert(loc, idxTy, lb);
+          } else {
+            lb = one;
+          }
+          lbounds.emplace_back(lb);
+        }
+        mlir::Value ub = fir::getBase(converter.genExprValue(
+            loc, Fortran::semantics::GetExpr(std::get<1>(shapeSpec.t)), stmtCtx));
+        ub = builder.createConvert(loc, idxTy, ub);
+        if (lb) {
+          mlir::Value diff = mlir::arith::SubIOp::create(builder, loc, ub, lb);
+          extents.emplace_back(
+              mlir::arith::AddIOp::create(builder, loc, diff, one));
         } else {
-          lb = one;
+          extents.emplace_back(ub);
         }
-        lbounds.emplace_back(lb);
       }
-      mlir::Value ub = fir::getBase(converter.genExprValue(
-          loc, Fortran::semantics::GetExpr(std::get<1>(shapeSpec.t)), stmtCtx));
-      ub = builder.createConvert(loc, idxTy, ub);
-      if (lb) {
-        mlir::Value diff = mlir::arith::SubIOp::create(builder, loc, ub, lb);
-        extents.emplace_back(
-            mlir::arith::AddIOp::create(builder, loc, diff, one));
+    }
+    else {
+      // Handle AllocateShapeSpecArray (F2023 array bounds feature)
+      const auto &shapeSpecArray{alloc.getShapeSpecArrays()};
+      const auto &lowerOptBoundsExpr{std::get<0>(shapeSpecArray.t)};
+      const auto &upperBoundsExpr{std::get<1>(shapeSpecArray.t)};
+      
+      // Get the semantic expressions
+      const Fortran::lower::SomeExpr *ubExpr = 
+          Fortran::semantics::GetExpr(upperBoundsExpr);
+      const Fortran::lower::SomeExpr *lbExpr = 
+          lowerOptBoundsExpr ? Fortran::semantics::GetExpr(*lowerOptBoundsExpr) 
+                             : nullptr;
+      
+      // Determine ranks
+      int ubRank = ubExpr->Rank();
+      int lbRank = lbExpr ? lbExpr->Rank() : 0;
+      
+      // Get numDims from whichever bound is an array (at least one must be)
+      int64_t numDims = -1;
+      if (ubRank == 1) {
+        auto ubShape = Fortran::evaluate::GetShape(
+            converter.getFoldingContext(), *ubExpr);
+        if (const auto &extent = (*ubShape)[0]) {
+          if (auto constExtent = Fortran::evaluate::ToInt64(*extent)) {
+            numDims = *constExtent;
+          }
+        }
+      } else if (lbRank == 1) {
+        auto lbShape = Fortran::evaluate::GetShape(
+            converter.getFoldingContext(), *lbExpr);
+        if (const auto &extent = (*lbShape)[0]) {
+          if (auto constExtent = Fortran::evaluate::ToInt64(*extent)) {
+            numDims = *constExtent;
+          }
+        }
+      }
+      assert(numDims > 0 && "bounds array must have known constant size");
----------------
ivanrodriguez3753 wrote:

numDims should be named differently

https://github.com/llvm/llvm-project/pull/178089