Commit 57e38bc6 authored by Slava Zakharin's avatar Slava Zakharin
Browse files

[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
parent 6d667d4b

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

+5 −0
Original line number Diff line number Diff line
@@ -181,6 +181,11 @@ public: 
    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; }

flang/lib/Optimizer/Builder/HLFIRTools.cpp

+1 −1
Original line number Diff line number Diff line
@@ -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,

flang/test/HLFIR/optional_dummy.f90

0 → 100644
+28 −0
Original line number Diff line number Diff line 
! 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