[flang-commits] [flang] fd66fa5 - [flang] Retrieve shape from selector when generating assoc sym type (#137117)

[via flang-commits]

Author: Kareem Ergawy
Date: 2025-06-02T15:49:58+02:00
New Revision: fd66fa56c428d5d403b3b887b89210f80b12f421

URL: https://github.com/llvm/llvm-project/commit/fd66fa56c428d5d403b3b887b89210f80b12f421
DIFF: https://github.com/llvm/llvm-project/commit/fd66fa56c428d5d403b3b887b89210f80b12f421.diff

LOG: [flang] Retrieve shape from selector when generating assoc sym type (#137117)

This PR extends `genSymbolType` so that the type of an associating
symbol carries the shape of the selector expression, if any. This is a
fix for a bug that triggered when an associating symbol is used in a
locality specifier. For example, given the following input:

```fortran
  associate(a => aa(4:))
    do concurrent (i = 4:11) local(a)
      a(i) = 0
    end do
  end associate
```
before the changes in the PR, flang would assert that we are casting
between incompatible types. The issue happened since for the associating
symbol (`a`), flang generated its type as `f32` rather than
`!fir.array<8xf32>` as it should be in this case.

Added: 
    flang/test/Lower/do_concurrent_local_assoc_entity.f90

Modified: 
    flang/lib/Lower/ConvertType.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index d45f9e7c0bf1b..7a2e8e5095186 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -276,19 +276,23 @@ struct TypeBuilderImpl {
     } else {
       fir::emitFatalError(loc, "symbol must have a type");
     }
-    bool isPolymorphic = (Fortran::semantics::IsPolymorphic(symbol) ||
-                          Fortran::semantics::IsUnlimitedPolymorphic(symbol)) &&
-                         !Fortran::semantics::IsAssumedType(symbol);
-    if (ultimate.IsObjectArray()) {
-      auto shapeExpr =
-          Fortran::evaluate::GetShape(converter.getFoldingContext(), ultimate);
+
+    auto shapeExpr =
+        Fortran::evaluate::GetShape(converter.getFoldingContext(), ultimate);
+
+    if (shapeExpr && !shapeExpr->empty()) {
+      // Statically ranked array.
       fir::SequenceType::Shape shape;
-      // If there is no shapExpr, this is an assumed-rank, and the empty shape
-      // will build the desired fir.array<*:T> type.
-      if (shapeExpr)
-        translateShape(shape, std::move(*shapeExpr));
+      translateShape(shape, std::move(*shapeExpr));
       ty = fir::SequenceType::get(shape, ty);
+    } else if (!shapeExpr) {
+      // Assumed-rank.
+      ty = fir::SequenceType::get(fir::SequenceType::Shape{}, ty);
     }
+
+    bool isPolymorphic = (Fortran::semantics::IsPolymorphic(symbol) ||
+                          Fortran::semantics::IsUnlimitedPolymorphic(symbol)) &&
+                         !Fortran::semantics::IsAssumedType(symbol);
     if (Fortran::semantics::IsPointer(symbol))
       return fir::wrapInClassOrBoxType(fir::PointerType::get(ty),
                                        isPolymorphic);

diff  --git a/flang/test/Lower/do_concurrent_local_assoc_entity.f90 b/flang/test/Lower/do_concurrent_local_assoc_entity.f90
new file mode 100644
index 0000000000000..280827871aaf4
--- /dev/null
+++ b/flang/test/Lower/do_concurrent_local_assoc_entity.f90
@@ -0,0 +1,22 @@
+! RUN: %flang_fc1 -emit-hlfir -o - %s | FileCheck %s
+
+subroutine local_assoc
+  implicit none
+  integer  i
+  real, dimension(2:11) :: aa
+
+  associate(a => aa(4:))
+    do concurrent (i = 4:11) local(a)
+      a(i) = 0
+    end do
+  end associate
+end subroutine local_assoc
+
+! CHECK: %[[C8:.*]] = arith.constant 8 : index
+
+! CHECK: fir.do_concurrent.loop {{.*}} {
+! CHECK:   %[[LOCAL_ALLOC:.*]] = fir.alloca !fir.array<8xf32> {bindc_name = "a", pinned, uniq_name = "{{.*}}local_assocEa"}
+! CHECK:   %[[LOCAL_SHAPE:.*]] = fir.shape %[[C8]] :
+! CHECK:   %[[LOCAL_DECL:.*]]:2 = hlfir.declare %[[LOCAL_ALLOC]](%[[LOCAL_SHAPE]])
+! CHECK:   hlfir.designate %[[LOCAL_DECL]]#0 (%{{.*}})
+! CHECK: }