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

[clementval]

Summary

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.

Co-authored-by: Eric Schweitz <[e-mail]>

flang/include/flang/Optimizer/Dialect/FIRType.h

if (auto shTy = t.dyn_cast<fir::ShapeType>())
     return shTy.getRank();
   if (auto shTy = t.dyn_cast<fir::ShapeShiftType>())
     return shTy.getRank();
   if (auto shTy = t.dyn_cast<fir::ShiftType>())
     return shTy.getRank();
   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>())
     return seqTy.getEleTy();
   return t;
 }
 
 inline mlir::Type unwrapRefType(mlir::Type t) {

flang/lib/Lower/ConvertExpr.cpp

if (auto upper = substring->upper())
       bounds.push_back(fir::getBase(asScalar(*upper)));
   }
 
   /// Convert the original value, \p origVal, to type \p eleTy. When in a
   /// pointer assignment context, generate an appropriate `fir.rebox` for
   /// 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();
       if (lbs.size() > 0) {
         // Rebox the value with user-specified shift.
         auto shiftTy = fir::ShiftType::get(eleTy.getContext(), lbs.size());
         mlir::Value shiftOp = builder.create<fir::ShiftOp>(loc, shiftTy, lbs);
         val = builder.create<fir::ReboxOp>(loc, eleTy, val, shiftOp,
if (isProjectedCopyInCopyOut()) {
               fir::factory::getTypeParams(loc, builder, load));
           mlir::Value addr = components.getExtendCoorRef()(arrayOp);
           components.resetExtendCoorRef();
           // When the lhs is a boxed value and the context is not a pointer
           // assignment, then insert the dereference of the box before any
           // 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);
             }
           }
           auto ele = convertElementForUpdate(loc, eleTy, iters.getElement());
           builder.create<fir::StoreOp>(loc, ele, addr);
           auto amend = builder.create<fir::ArrayAmendOp>(
               loc, innerArg.getType(), innerArg, arrayOp);

 
   template <typename A>
   CC genAsScalar(const A &x) {
     mlir::Location loc = getLoc();
     if (isProjectedCopyInCopyOut()) {
       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(
                 exv, iters.elementExv());
           } else if (fir::isa_derived(eleTy)) {
             TODO(loc, "assignment of derived type");
           } else {
             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;
       };
     }
     return [=, &x](IterSpace) { return asScalar(x); };
   }
 
   bool tailIsPointerInPointerAssignment(const Fortran::semantics::Symbol &x,

flang/test/Lower/forall/degenerate.f90

+! 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
+