[flang] fix isSimplyContiguous and isOptional hlfir::Entity methods

flang/include/flang/Optimizer/Builder/HLFIRTools.h

@@ -150,10 +150,7 @@ class Entity : public mlir::Value {
     return base.getDefiningOp<fir::FortranVariableOpInterface>();
   }
 
-  bool isOptional() const {
-    auto varIface = getIfVariableInterface();
-    return varIface ? varIface.isOptional() : false;
-  }
+  bool mayBeOptional() const;
 
   bool isParameter() const {
     auto varIface = getIfVariableInterface();
@@ -210,7 +207,8 @@ class EntityWithAttributes : public Entity {
 using CleanupFunction = std::function<void()>;
 std::pair<fir::ExtendedValue, std::optional<CleanupFunction>>
 translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
-                         Entity entity, bool contiguousHint = false);
+                         Entity entity, bool contiguousHint = false,
+                         bool keepScalarOptionalBoxed = false);
 
 /// Function to translate FortranVariableOpInterface to fir::ExtendedValue.
 /// It may generates IR to unbox fir.boxchar, but has otherwise no side effects

flang/lib/Optimizer/Builder/HLFIRTools.cpp

@@ -221,6 +221,25 @@ bool hlfir::Entity::mayHaveNonDefaultLowerBounds() const {
   return true;
 }
 
+mlir::Operation *traverseConverts(mlir::Operation *op) {
+  while (auto convert = llvm::dyn_cast_or_null<fir::ConvertOp>(op))
+    op = convert.getValue().getDefiningOp();
+  return op;
+}
+
+bool hlfir::Entity::mayBeOptional() const {
+  if (!isVariable())
+    return false;
+  // TODO: introduce a fir type to better identify optionals.
+  if (mlir::Operation *op = traverseConverts(getDefiningOp())) {
+    if (auto varIface = llvm::dyn_cast<fir::FortranVariableOpInterface>(op))
+      return varIface.isOptional();
+    return !llvm::isa<fir::AllocaOp, fir::AllocMemOp, fir::ReboxOp,
+                      fir::EmboxOp, fir::LoadOp>(op);
+  }
+  return true;
+}
+
 fir::FortranVariableOpInterface
 hlfir::genDeclare(mlir::Location loc, fir::FirOpBuilder &builder,
                   const fir::ExtendedValue &exv, llvm::StringRef name,
@@ -963,9 +982,69 @@ llvm::SmallVector<mlir::Value> hlfir::genLoopNestWithReductions(
   return outerLoop->getResults();
 }
 
+template <typename Lambda>
+static fir::ExtendedValue
+conditionnalyEvaluate(mlir::Location loc, fir::FirOpBuilder &builder,
+                      mlir::Value condition, const Lambda &genIfTrue) {
+  mlir::OpBuilder::InsertPoint insertPt = builder.saveInsertionPoint();
+
+  // Evaluate in some region that will be moved into the actual ifOp (the actual
+  // ifOp can only be created when the result types are known).
+  auto badIfOp = builder.create<fir::IfOp>(loc, condition.getType(), condition,
+                                           /*withElseRegion=*/false);
+  mlir::Block *preparationBlock = &badIfOp.getThenRegion().front();
+  builder.setInsertionPointToStart(preparationBlock);
+  fir::ExtendedValue result = genIfTrue();
+  fir::ResultOp resultOp = result.match(
+      [&](const fir::CharBoxValue &box) -> fir::ResultOp {
+        return builder.create<fir::ResultOp>(
+            loc, mlir::ValueRange{box.getAddr(), box.getLen()});
+      },
+      [&](const mlir::Value &addr) -> fir::ResultOp {
+        return builder.create<fir::ResultOp>(loc, addr);
+      },
+      [&](const auto &) -> fir::ResultOp {
+        TODO(loc, "unboxing non scalar optional fir.box");
+      });
+  builder.restoreInsertionPoint(insertPt);
+
+  // Create actual fir.if operation.
+  auto ifOp =
+      builder.create<fir::IfOp>(loc, resultOp->getOperandTypes(), condition,
+                                /*withElseRegion=*/true);
+  // Move evaluation into Then block,
+  preparationBlock->moveBefore(&ifOp.getThenRegion().back());
+  ifOp.getThenRegion().back().erase();
+  // Create absent result in the Else block.
+  builder.setInsertionPointToStart(&ifOp.getElseRegion().front());
+  llvm::SmallVector<mlir::Value> absentValues;
+  for (mlir::Type resTy : ifOp->getResultTypes()) {
+    if (fir::isa_ref_type(resTy) || fir::isa_box_type(resTy))
+      absentValues.emplace_back(builder.create<fir::AbsentOp>(loc, resTy));
+    else
+      absentValues.emplace_back(builder.create<fir::ZeroOp>(loc, resTy));
+  }
+  builder.create<fir::ResultOp>(loc, absentValues);
+  badIfOp->erase();
+
+  // Build fir::ExtendedValue from the result values.
+  builder.setInsertionPointAfter(ifOp);
+  return result.match(
+      [&](const fir::CharBoxValue &box) -> fir::ExtendedValue {
+        return fir::CharBoxValue{ifOp.getResult(0), ifOp.getResult(1)};
+      },
+      [&](const mlir::Value &) -> fir::ExtendedValue {
+        return ifOp.getResult(0);
+      },
+      [&](const auto &) -> fir::ExtendedValue {
+        TODO(loc, "unboxing non scalar optional fir.box");
+      });
+}
+
 static fir::ExtendedValue translateVariableToExtendedValue(
     mlir::Location loc, fir::FirOpBuilder &builder, hlfir::Entity variable,
-    bool forceHlfirBase = false, bool contiguousHint = false) {
+    bool forceHlfirBase = false, bool contiguousHint = false,
+    bool keepScalarOptionalBoxed = false) {
   assert(variable.isVariable() && "must be a variable");
   // When going towards FIR, use the original base value to avoid
   // introducing descriptors at runtime when they are not required.
@@ -984,14 +1063,33 @@ static fir::ExtendedValue translateVariableToExtendedValue(
     const bool contiguous = variable.isSimplyContiguous() || contiguousHint;
     const bool isAssumedRank = variable.isAssumedRank();
     if (!contiguous || variable.isPolymorphic() ||
-        variable.isDerivedWithLengthParameters() || variable.isOptional() ||
-        isAssumedRank) {
+        variable.isDerivedWithLengthParameters() || isAssumedRank) {
       llvm::SmallVector<mlir::Value> nonDefaultLbounds;
       if (!isAssumedRank)
         nonDefaultLbounds = getNonDefaultLowerBounds(loc, builder, variable);
       return fir::BoxValue(base, nonDefaultLbounds,
                            getExplicitTypeParams(variable));
     }
+    if (variable.mayBeOptional()) {
+      if (!keepScalarOptionalBoxed && variable.isScalar()) {
+        mlir::Value isPresent = builder.create<fir::IsPresentOp>(
+            loc, builder.getI1Type(), variable);
+        return conditionnalyEvaluate(
+            loc, builder, isPresent, [&]() -> fir::ExtendedValue {
+              mlir::Value base = genVariableRawAddress(loc, builder, variable);
+              if (variable.isCharacter()) {
+                mlir::Value len =
+                    genCharacterVariableLength(loc, builder, variable);
+                return fir::CharBoxValue{base, len};
+              }
+              return base;
+            });
+      }
+      llvm::SmallVector<mlir::Value> nonDefaultLbounds =
+          getNonDefaultLowerBounds(loc, builder, variable);
+      return fir::BoxValue(base, nonDefaultLbounds,
+                           getExplicitTypeParams(variable));
+    }
     // Otherwise, the variable can be represented in a fir::ExtendedValue
     // without the overhead of a fir.box.
     base = genVariableRawAddress(loc, builder, variable);
@@ -1035,10 +1133,12 @@ hlfir::translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
 
 std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
 hlfir::translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
-                                hlfir::Entity entity, bool contiguousHint) {
+                                hlfir::Entity entity, bool contiguousHint,
+                                bool keepScalarOptionalBoxed) {
   if (entity.isVariable())
     return {translateVariableToExtendedValue(loc, builder, entity, false,
-                                             contiguousHint),
+                                             contiguousHint,
+                                             keepScalarOptionalBoxed),
             std::nullopt};
 
   if (entity.isProcedure()) {
@@ -1094,7 +1194,9 @@ hlfir::convertToBox(mlir::Location loc, fir::FirOpBuilder &builder,
   if (entity.isProcedurePointer())
     entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);
 
-  auto [exv, cleanup] = translateToExtendedValue(loc, builder, entity);
+  auto [exv, cleanup] =
+      translateToExtendedValue(loc, builder, entity, /*contiguousHint=*/false,
+                               /*keepScalarOptionalBoxed=*/true);
   // Procedure entities should not go through createBoxValue that embox
   // object entities. Return the fir.boxproc directly.
   if (entity.isProcedure())

flang/lib/Optimizer/HLFIR/Transforms/LowerHLFIRIntrinsics.cpp

@@ -121,8 +121,14 @@ class HlfirIntrinsicConversion : public mlir::OpRewritePattern<OP> {
         // simplified since the fir.box lowered here are now guarenteed to
         // contain the local lower bounds thanks to the hlfir.declare (the extra
         // rebox can be removed).
-        auto [exv, cleanup] =
-            hlfir::translateToExtendedValue(loc, builder, entity);
+        // When taking arguments as descriptors, the runtime expect absent
+        // OPTIONAL to be a nullptr to a descriptor, lowering has already
+        // prepared such descriptors        // as needed, hence set
+        // keepScalarOptionalBoxed to avoid building descriptors with a null
+        // address for them.
+        auto [exv, cleanup] = hlfir::translateToExtendedValue(
+            loc, builder, entity, /*contiguous=*/false,
+            /*keepScalarOptionalBoxed=*/true);
         if (cleanup)
           cleanupFns.push_back(*cleanup);
         ret.emplace_back(exv);

flang/test/HLFIR/assign-codegen.fir

@@ -429,11 +429,55 @@ func.func @test_upoly_expr_assignment(%arg0: !fir.class<!fir.array<?xnone>> {fir
 // CHECK:         }
 
 func.func @test_scalar_box(%arg0: f32, %arg1: !fir.box<!fir.ptr<f32>>) {
-  hlfir.assign %arg0 to %arg1 : f32, !fir.box<!fir.ptr<f32>>
+  %x = fir.declare %arg1 {uniq_name = "x"} : (!fir.box<!fir.ptr<f32>>) -> !fir.box<!fir.ptr<f32>>
+  hlfir.assign %arg0 to %x : f32, !fir.box<!fir.ptr<f32>>
   return
 }
 // CHECK-LABEL:   func.func @test_scalar_box(
 // CHECK-SAME:                               %[[VAL_0:.*]]: f32,
 // CHECK-SAME:                               %[[VAL_1:.*]]: !fir.box<!fir.ptr<f32>>) {
-// CHECK:           %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<f32>>) -> !fir.ptr<f32>
-// CHECK:           fir.store %[[VAL_0]] to %[[VAL_2]] : !fir.ptr<f32>
+// CHECK:           %[[VAL_2:.*]] = fir.declare %[[VAL_1]] {uniq_name = "x"} : (!fir.box<!fir.ptr<f32>>) -> !fir.box<!fir.ptr<f32>>
+// CHECK:           %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.ptr<f32>>) -> !fir.ptr<f32>
+// CHECK:           fir.store %[[VAL_0]] to %[[VAL_3]] : !fir.ptr<f32>
+
+func.func @test_scalar_opt_box(%arg0: f32, %arg1: !fir.box<!fir.ptr<f32>>) {
+  %x = fir.declare %arg1 {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "x"} : (!fir.box<!fir.ptr<f32>>) -> !fir.box<!fir.ptr<f32>>
+  hlfir.assign %arg0 to %x : f32, !fir.box<!fir.ptr<f32>>
+  return
+}
+// CHECK-LABEL:   func.func @test_scalar_opt_box(
+// CHECK-SAME:                                   %[[VAL_0:.*]]: f32,
+// CHECK-SAME:                                   %[[VAL_1:.*]]: !fir.box<!fir.ptr<f32>>) {
+// CHECK:           %[[VAL_2:.*]] = fir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "x"} : (!fir.box<!fir.ptr<f32>>) -> !fir.box<!fir.ptr<f32>>
+// CHECK:           %[[VAL_3:.*]] = fir.is_present %[[VAL_2]] : (!fir.box<!fir.ptr<f32>>) -> i1
+// CHECK:           %[[VAL_4:.*]] = fir.if %[[VAL_3]] -> (!fir.ptr<f32>) {
+// CHECK:             %[[VAL_5:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.ptr<f32>>) -> !fir.ptr<f32>
+// CHECK:             fir.result %[[VAL_5]] : !fir.ptr<f32>
+// CHECK:           } else {
+// CHECK:             %[[VAL_6:.*]] = fir.absent !fir.ptr<f32>
+// CHECK:             fir.result %[[VAL_6]] : !fir.ptr<f32>
+// CHECK:           }
+// CHECK:           fir.store %[[VAL_0]] to %[[VAL_4]] : !fir.ptr<f32>
+
+func.func @test_scalar_opt_char_box(%arg0: !fir.ref<!fir.char<1,10>>, %arg1: !fir.box<!fir.char<1,?>>) {
+  %x = fir.declare %arg1 {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "x"} : (!fir.box<!fir.char<1,?>>) -> !fir.box<!fir.char<1,?>>
+  hlfir.assign %arg0 to %x : !fir.ref<!fir.char<1,10>>, !fir.box<!fir.char<1,?>>
+  return
+}
+// CHECK-LABEL:   func.func @test_scalar_opt_char_box(
+// CHECK-SAME:                                        %[[VAL_0:.*]]: !fir.ref<!fir.char<1,10>>,
+// CHECK-SAME:                                        %[[VAL_1:.*]]: !fir.box<!fir.char<1,?>>) {
+// CHECK:           %[[VAL_2:.*]] = fir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "x"} : (!fir.box<!fir.char<1,?>>) -> !fir.box<!fir.char<1,?>>
+// CHECK:           %[[VAL_3:.*]] = arith.constant 10 : index
+// CHECK:           %[[VAL_4:.*]] = fir.is_present %[[VAL_2]] : (!fir.box<!fir.char<1,?>>) -> i1
+// CHECK:           %[[VAL_5:.*]]:2 = fir.if %[[VAL_4]] -> (!fir.ref<!fir.char<1,?>>, index) {
+// CHECK:             %[[VAL_6:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,?>>
+// CHECK:             %[[VAL_7:.*]] = fir.box_elesize %[[VAL_2]] : (!fir.box<!fir.char<1,?>>) -> index
+// CHECK:             fir.result %[[VAL_6]], %[[VAL_7]] : !fir.ref<!fir.char<1,?>>, index
+// CHECK:           } else {
+// CHECK:             %[[VAL_8:.*]] = fir.absent !fir.ref<!fir.char<1,?>>
+// CHECK:             %[[VAL_9:.*]] = fir.zero_bits index
+// CHECK:             fir.result %[[VAL_8]], %[[VAL_9]] : !fir.ref<!fir.char<1,?>>, index
+// CHECK:           }
+// ...
+// CHECK:           fir.call @llvm.memmove.p0.p0.i64(

flang/test/HLFIR/maxval-lowering.fir

@@ -216,3 +216,25 @@ func.func @_QPmaxval6(%arg0: !fir.box<!fir.array<?x!fir.char<1,?>>> {fir.bindc_n
 // CHECK:         hlfir.destroy %[[ASEXPR]]
 // CHECK-NEXT:    return
 // CHECK-NEXT:  }
+
+func.func @_QPmaxval_opt_mask(%arg0: !fir.box<!fir.array<?x?xf32>> {fir.bindc_name = "input"}, %arg1: !fir.ref<!fir.logical<4>> {fir.bindc_name = "mask", fir.optional}) -> f32 {
+  %0 = fir.dummy_scope : !fir.dscope
+  %1:2 = hlfir.declare %arg0 dummy_scope %0 {fortran_attrs = #fir.var_attrs<intent_in>, uniq_name = "_QFmaxval_opt_maskEinput"} : (!fir.box<!fir.array<?x?xf32>>, !fir.dscope) -> (!fir.box<!fir.array<?x?xf32>>, !fir.box<!fir.array<?x?xf32>>)
+  %2:2 = hlfir.declare %arg1 dummy_scope %0 {fortran_attrs = #fir.var_attrs<intent_in, optional>, uniq_name = "_QFmaxval_opt_maskEmask"} : (!fir.ref<!fir.logical<4>>, !fir.dscope) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>)
+  %3 = fir.alloca f32 {bindc_name = "maxval_1", uniq_name = "_QFmaxval_opt_maskEmaxval_1"}
+  %4:2 = hlfir.declare %3 {uniq_name = "_QFmaxval_opt_maskEmaxval_1"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
+  %5 = fir.is_present %2#0 : (!fir.ref<!fir.logical<4>>) -> i1
+  %6 = fir.embox %2#1 : (!fir.ref<!fir.logical<4>>) -> !fir.box<!fir.logical<4>>
+  %7 = fir.absent !fir.box<!fir.logical<4>>
+  %8 = arith.select %5, %6, %7 : !fir.box<!fir.logical<4>>
+  %9 = hlfir.maxval %1#0 mask %8 : (!fir.box<!fir.array<?x?xf32>>, !fir.box<!fir.logical<4>>) -> f32
+  hlfir.assign %9 to %4#0 : f32, !fir.ref<f32>
+  %10 = fir.load %4#1 : !fir.ref<f32>
+  return %10 : f32
+}
+// CHECK-LABEL:   func.func @_QPmaxval_opt_mask(
+// CHECK:           %[[VAL_10:.*]] = fir.embox %{{.*}} : (!fir.ref<!fir.logical<4>>) -> !fir.box<!fir.logical<4>>
+// CHECK:           %[[VAL_11:.*]] = fir.absent !fir.box<!fir.logical<4>>
+// CHECK:           %[[VAL_12:.*]] = arith.select %{{.*}}, %[[VAL_10]], %[[VAL_11]] : !fir.box<!fir.logical<4>>
+// CHECK:           %[[VAL_17:.*]] = fir.convert %[[VAL_12]] : (!fir.box<!fir.logical<4>>) -> !fir.box<none>                                                                  
+// CHECK:           %[[VAL_18:.*]] = fir.call @_FortranAMaxvalReal4(%{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) : (!fir.box<none>, !fir.ref<i8>, i32, i32, !fir.box<none>) -> f32