diff --git a/flang/include/flang/Optimizer/Builder/HLFIRTools.h b/flang/include/flang/Optimizer/Builder/HLFIRTools.h --- a/flang/include/flang/Optimizer/Builder/HLFIRTools.h +++ b/flang/include/flang/Optimizer/Builder/HLFIRTools.h @@ -181,6 +181,11 @@ return base.getDefiningOp(); } + 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 --- a/flang/lib/Optimizer/Builder/HLFIRTools.cpp +++ b/flang/lib/Optimizer/Builder/HLFIRTools.cpp @@ -791,7 +791,7 @@ if (firBase.getType().isa()) { if (!variable.isSimplyContiguous() || variable.isPolymorphic() || - variable.isDerivedWithLengthParameters()) { + variable.isDerivedWithLengthParameters() || variable.isOptional()) { llvm::SmallVector 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 --- /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.bindc_name = "ext_buf", fir.contiguous, fir.optional}) { +! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtestEext_buf"} : (!fir.box>) -> (!fir.box>, !fir.box>) +! CHECK: %[[VAL_2:.*]] = fir.is_present %[[VAL_1]]#1 : (!fir.box>) -> 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 : (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