[flang] Make sure that conversions are applied in FORALL degenerate contexts

For the rapid triage push, just add a TODO for the degenerate POINTER
assignment case. The LHD ought to be a variable of type !fir.box, but it
is currently returning a shadow variable for the raw data pointer. More
investigation is needed there.
Make sure that conversions are applied in FORALL degenerate contexts.

This patch is part of the upstreaming effort from fir-dev branch.

Reviewed By: jeanPerier

Differential Revision: https://reviews.llvm.org/D128724

Co-authored-by: Eric Schweitz <eschweitz@nvidia.com>

diff --git a/flang/include/flang/Optimizer/Dialect/FIRType.h b/flang/include/flang/Optimizer/Dialect/FIRType.h
index 4c0085eab1cfdab024ab1768fe080d52b719f1b2..74df83a89bdd0671f076c6744d7e95389f251aca 100644 (file)
--- a/flang/include/flang/Optimizer/Dialect/FIRType.h
+++ b/flang/include/flang/Optimizer/Dialect/FIRType.h
@@ -171,6 +171,14 @@ inline unsigned getRankOfShapeType(mlir::Type t) {
   return 0;
 }
 
+/// Get the memory reference type of the data pointer from the box type,
+inline mlir::Type boxMemRefType(fir::BoxType t) {
+  auto eleTy = t.getEleTy();
+  if (!eleTy.isa<fir::PointerType, fir::HeapType>())
+    eleTy = fir::ReferenceType::get(t);
+  return eleTy;
+}
+
 /// If `t` is a SequenceType return its element type, otherwise return `t`.
 inline mlir::Type unwrapSequenceType(mlir::Type t) {
   if (auto seqTy = t.dyn_cast<fir::SequenceType>())

diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 20e7c33df5a6d4fca4f1fc34becb5c80852fb7fd..44b6be60a1cabd5be0901dbb425d2e424951f552 100644 (file)
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -4100,6 +4100,11 @@ private:
   /// dealing with any bounds parameters on the pointer assignment.
   mlir::Value convertElementForUpdate(mlir::Location loc, mlir::Type eleTy,
                                       mlir::Value origVal) {
+    if (origVal.getType().isa<fir::BoxType>() && !eleTy.isa<fir::BoxType>()) {
+      if (isPointerAssignment())
+        TODO(loc, "lhs of pointer assignment returned unexpected value");
+      TODO(loc, "invalid box conversion in elemental computation");
+    }
     mlir::Value val = builder.createConvert(loc, eleTy, origVal);
     if (isBoundsSpec()) {
       auto lbs = lbounds.value();
@@ -6848,10 +6853,7 @@ private:
           // conversion and store.
           if (!isPointerAssignment()) {
             if (auto boxTy = eleTy.dyn_cast<fir::BoxType>()) {
-              eleTy = boxTy.getEleTy();
-              if (!(eleTy.isa<fir::PointerType>() ||
-                    eleTy.isa<fir::HeapType>()))
-                eleTy = builder.getRefType(eleTy);
+              eleTy = fir::boxMemRefType(boxTy);
               addr = builder.create<fir::BoxAddrOp>(loc, eleTy, addr);
               eleTy = fir::unwrapRefType(eleTy);
             }
@@ -6973,8 +6975,8 @@ private:
       return [=, &x, builder = &converter.getFirOpBuilder()](
                  IterSpace iters) -> ExtValue {
         ExtValue exv = asScalarRef(x);
-        mlir::Value val = fir::getBase(exv);
-        mlir::Type eleTy = fir::unwrapRefType(val.getType());
+        mlir::Value addr = fir::getBase(exv);
+        mlir::Type eleTy = fir::unwrapRefType(addr.getType());
         if (isAdjustedArrayElementType(eleTy)) {
           if (fir::isa_char(eleTy)) {
             fir::factory::CharacterExprHelper{*builder, loc}.createAssign(
@@ -6985,7 +6987,8 @@ private:
             fir::emitFatalError(loc, "array type not expected in scalar");
           }
         } else {
-          builder->create<fir::StoreOp>(loc, iters.getElement(), val);
+          auto eleVal = convertElementForUpdate(loc, eleTy, iters.getElement());
+          builder->create<fir::StoreOp>(loc, eleVal, addr);
         }
         return exv;
       };

diff --git a/flang/test/Lower/forall/degenerate.f90 b/flang/test/Lower/forall/degenerate.f90
new file mode 100644 (file)
index 0000000..70598c9
--- /dev/null
+++ b/flang/test/Lower/forall/degenerate.f90
@@ -0,0 +1,38 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func @_QPpointer_forall_degenerated_assignment() {
+
+subroutine pointer_forall_degenerated_assignment()
+  integer, pointer :: p
+  integer, target :: t(1)
+  forall (i=1:1)
+     ! Test hits a TODO when uncommented.
+     ! p => t(i)
+  end forall
+end subroutine
+
+! CHECK-LABEL: func @_QPlogical_forall_degenerated_assignment() {
+! CHECK:         %[[VAL_0:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"}
+! CHECK:         %[[VAL_1:.*]] = fir.alloca !fir.logical<4> {bindc_name = "l", uniq_name = "_QFlogical_forall_degenerated_assignmentEl"}
+! CHECK:         %[[VAL_2:.*]] = arith.constant 1 : i32
+! CHECK:         %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (i32) -> index
+! CHECK:         %[[VAL_4:.*]] = arith.constant 1 : i32
+! CHECK:         %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i32) -> index
+! CHECK:         %[[VAL_6:.*]] = arith.constant 1 : index
+! CHECK:         fir.do_loop %[[VAL_7:.*]] = %[[VAL_3]] to %[[VAL_5]] step %[[VAL_6]] unordered {
+! CHECK:           %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (index) -> i32
+! CHECK:           fir.store %[[VAL_8]] to %[[VAL_0]] : !fir.ref<i32>
+! CHECK:           %[[VAL_9:.*]] = arith.constant true
+! CHECK:           %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i1) -> !fir.logical<4>
+! CHECK:           fir.store %[[VAL_10]] to %[[VAL_1]] : !fir.ref<!fir.logical<4>>
+! CHECK:         }
+! CHECK:         return
+! CHECK:       }
+
+subroutine logical_forall_degenerated_assignment()
+  logical :: l
+  forall (i=1:1)
+    l = .true.
+  end forall
+end subroutine
+