[flang-commits] [flang] 57e38bc - [flang][hlfir] Fixed lowering for optional dummy.

[Slava Zakharin via flang-commits]

Author: Slava Zakharin
Date: 2023-05-01T09:53:14-07:00
New Revision: 57e38bc6c8e2712aedf3dbef98265d3320c4906d

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

LOG: [flang][hlfir] Fixed lowering for optional dummy.

We have to keep it as a box, since taking box_addr of the optional
box may be invalid.

Reviewed By: jeanPerier

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

Added: 
    flang/test/HLFIR/optional_dummy.f90

Modified: 
    flang/include/flang/Optimizer/Builder/HLFIRTools.h
    flang/lib/Optimizer/Builder/HLFIRTools.cpp

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Optimizer/Builder/HLFIRTools.h b/flang/include/flang/Optimizer/Builder/HLFIRTools.h
index 8f4eb713ae5dd..5d64903eeb87b 100644
--- a/flang/include/flang/Optimizer/Builder/HLFIRTools.h
+++ b/flang/include/flang/Optimizer/Builder/HLFIRTools.h
@@ -181,6 +181,11 @@ class Entity : public mlir::Value {
     return base.getDefiningOp<fir::FortranVariableOpInterface>();
   }
 
+  bool isOptional() const {
+    auto varIface = getIfVariableInterface();
+    return varIface ? varIface.isOptional() : false;
+  }
+
   // Get the entity as an mlir SSA value containing all the shape, type
   // parameters and dynamic shape information.
   mlir::Value getBase() const { return *this; }

diff  --git a/flang/lib/Optimizer/Builder/HLFIRTools.cpp b/flang/lib/Optimizer/Builder/HLFIRTools.cpp
index 3c6b29bfc5fb8..1d30bbba282ba 100644
--- a/flang/lib/Optimizer/Builder/HLFIRTools.cpp
+++ b/flang/lib/Optimizer/Builder/HLFIRTools.cpp
@@ -791,7 +791,7 @@ translateVariableToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
 
   if (firBase.getType().isa<fir::BaseBoxType>()) {
     if (!variable.isSimplyContiguous() || variable.isPolymorphic() ||
-        variable.isDerivedWithLengthParameters()) {
+        variable.isDerivedWithLengthParameters() || variable.isOptional()) {
       llvm::SmallVector<mlir::Value> nonDefaultLbounds =
           getNonDefaultLowerBounds(loc, builder, variable);
       return fir::BoxValue(firBase, nonDefaultLbounds,

diff  --git a/flang/test/HLFIR/optional_dummy.f90 b/flang/test/HLFIR/optional_dummy.f90
new file mode 100644
index 0000000000000..9dd2076f82a1a
--- /dev/null
+++ b/flang/test/HLFIR/optional_dummy.f90
@@ -0,0 +1,28 @@
+! RUN: bbc -emit-fir -hlfir %s -o - | FileCheck %s
+
+! Check that the lowering does not generate fir.box_addr for
+! the optional box. It will cause segfault during execution.
+
+! CHECK-LABEL:   func.func @_QPtest(
+! CHECK-SAME:        %[[VAL_0:.*]]: !fir.box<!fir.array<?xi32>> {fir.bindc_name = "ext_buf", fir.contiguous, fir.optional}) {
+! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<contiguous, optional>, uniq_name = "_QFtestEext_buf"} : (!fir.box<!fir.array<?xi32>>) -> (!fir.box<!fir.array<?xi32>>, !fir.box<!fir.array<?xi32>>)
+! CHECK:           %[[VAL_2:.*]] = fir.is_present %[[VAL_1]]#1 : (!fir.box<!fir.array<?xi32>>) -> i1
+! CHECK:           cf.cond_br %[[VAL_2]], ^bb1, ^bb2
+! CHECK:         ^bb1:
+! CHECK:           %[[VAL_3:.*]] = arith.constant 0 : i32
+! CHECK:           %[[VAL_4:.*]] = arith.constant false
+! CHECK:           %[[VAL_5:.*]] = arith.constant false
+! CHECK:           %[[VAL_6:.*]] = fir.call @_FortranAStopStatement(%[[VAL_3]], %[[VAL_4]], %[[VAL_5]]) fastmath<contract> : (i32, i1, i1) -> none
+! CHECK:           fir.unreachable
+! CHECK:         ^bb2:
+! CHECK:           cf.br ^bb3
+! CHECK:         ^bb3:
+! CHECK:           return
+! CHECK:         }
+subroutine test(ext_buf)
+  integer, contiguous, optional :: ext_buf(:)
+  if (present(ext_buf)) then
+     stop
+  endif
+  return
+end subroutine test