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 @@ -196,6 +196,11 @@ return varIface ? varIface.isOptional() : false; } + bool isParameter() const { + auto varIface = getIfVariableInterface(); + return varIface ? varIface.isParameter() : 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/include/flang/Optimizer/Dialect/FortranVariableInterface.td b/flang/include/flang/Optimizer/Dialect/FortranVariableInterface.td --- a/flang/include/flang/Optimizer/Dialect/FortranVariableInterface.td +++ b/flang/include/flang/Optimizer/Dialect/FortranVariableInterface.td @@ -163,6 +163,13 @@ return fir::isBoxAddressOrValue(getBase().getType()); } + /// Is this variable a Fortran parameter? + bool isParameter() { + auto attrs = getFortranAttrs(); + return attrs && bitEnumContainsAny(*attrs, + fir::FortranVariableFlagsEnum::parameter); + } + /// Interface verifier imlementation for declare operations. mlir::LogicalResult verifyDeclareLikeOpImpl(mlir::Value memRef); diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -912,7 +912,13 @@ loc, boxType, entity, /*shape=*/mlir::Value{}, /*slice=*/mlir::Value{})}; } - if (arg.hasValueAttribute()) { + if (arg.hasValueAttribute() || + // Constant expressions might be lowered as variables with + // 'parameter' attribute. Even though the constant expressions + // are not definable and explicit assignments to them are not + // possible, we have to create a temporary copies when we pass + // them down the call stack. + entity.isParameter()) { // Make a copy in a temporary. auto copy = builder.create(loc, entity); hlfir::AssociateOp associate = hlfir::genAssociateExpr( diff --git a/flang/test/Lower/HLFIR/calls-constant-expr-arg.f90 b/flang/test/Lower/HLFIR/calls-constant-expr-arg.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/HLFIR/calls-constant-expr-arg.f90 @@ -0,0 +1,64 @@ +! RUN: bbc -emit-fir -hlfir -o - %s | FileCheck %s + +! Test that the constant array expression actual argument +! is placed into a temporary inside 'test' subroutine before +! the call to 'sub'. This is required because the compiler-generated +! copy-out inside 'sub' after the call to 'sub2' will write +! into the dummy argument 'i'. If the constant array expression is passed +! directly byref to 'sub', the copy-out will try to modify readonly memory. +subroutine sub(i, n) + interface + subroutine sub2(i) + integer :: i(*) + end subroutine sub2 + end interface + integer :: i(n) + call sub2(i(3::2)) +end subroutine sub +! CHECK-LABEL: func.func @_QPsub( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref> {fir.bindc_name = "i"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref {fir.bindc_name = "n"}) { +! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QFsubEn"} : (!fir.ref) -> (!fir.ref, !fir.ref) +! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref +! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (i32) -> i64 +! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i64) -> index +! CHECK: %[[VAL_6:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_7:.*]] = arith.cmpi sgt, %[[VAL_5]], %[[VAL_6]] : index +! CHECK: %[[VAL_8:.*]] = arith.select %[[VAL_7]], %[[VAL_5]], %[[VAL_6]] : index +! CHECK: %[[VAL_9:.*]] = fir.shape %[[VAL_8]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_10:.*]]:2 = hlfir.declare %[[VAL_0]](%[[VAL_9]]) {uniq_name = "_QFsubEi"} : (!fir.ref>, !fir.shape<1>) -> (!fir.box>, !fir.ref>) +! CHECK: %[[VAL_11:.*]] = arith.constant 3 : index +! CHECK: %[[VAL_12:.*]] = arith.constant 2 : index +! CHECK: %[[VAL_13:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_14:.*]] = arith.subi %[[VAL_8]], %[[VAL_11]] : index +! CHECK: %[[VAL_15:.*]] = arith.addi %[[VAL_14]], %[[VAL_12]] : index +! CHECK: %[[VAL_16:.*]] = arith.divsi %[[VAL_15]], %[[VAL_12]] : index +! CHECK: %[[VAL_17:.*]] = arith.cmpi sgt, %[[VAL_16]], %[[VAL_13]] : index +! CHECK: %[[VAL_18:.*]] = arith.select %[[VAL_17]], %[[VAL_16]], %[[VAL_13]] : index +! CHECK: %[[VAL_19:.*]] = fir.shape %[[VAL_18]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_20:.*]] = hlfir.designate %[[VAL_10]]#0 (%[[VAL_11]]:%[[VAL_8]]:%[[VAL_12]]) shape %[[VAL_19]] : (!fir.box>, index, index, index, !fir.shape<1>) -> !fir.box> +! CHECK: %[[VAL_21:.*]]:2 = hlfir.copy_in %[[VAL_20]] : (!fir.box>) -> (!fir.box>, i1) +! CHECK: %[[VAL_22:.*]] = fir.box_addr %[[VAL_21]]#0 : (!fir.box>) -> !fir.ref> +! CHECK: fir.call @_QPsub2(%[[VAL_22]]) fastmath : (!fir.ref>) -> () +! CHECK: hlfir.copy_out %[[VAL_21]]#0, %[[VAL_21]]#1 to %[[VAL_20]] : (!fir.box>, i1, !fir.box>) -> () +! CHECK: return +! CHECK: } + +subroutine test + call sub((/1,2,3,4,5/), 5) +end subroutine test +! CHECK-LABEL: func.func @_QPtest() { +! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QQro.5xi4.0) : !fir.ref> +! CHECK: %[[VAL_1:.*]] = arith.constant 5 : index +! CHECK: %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]](%[[VAL_2]]) {fortran_attrs = #fir.var_attrs, uniq_name = "_QQro.5xi4.0"} : (!fir.ref>, !fir.shape<1>) -> (!fir.ref>, !fir.ref>) +! CHECK: %[[VAL_4:.*]] = arith.constant 5 : i32 +! CHECK: %[[VAL_5:.*]] = hlfir.as_expr %[[VAL_3]]#0 : (!fir.ref>) -> !hlfir.expr<5xi32> +! CHECK: %[[VAL_6:.*]]:3 = hlfir.associate %[[VAL_5]](%[[VAL_2]]) {uniq_name = "adapt.valuebyref"} : (!hlfir.expr<5xi32>, !fir.shape<1>) -> (!fir.ref>, !fir.ref>, i1) +! CHECK: %[[VAL_7:.*]]:3 = hlfir.associate %[[VAL_4]] {uniq_name = "adapt.valuebyref"} : (i32) -> (!fir.ref, !fir.ref, i1) +! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_6]]#1 : (!fir.ref>) -> !fir.ref> +! CHECK: fir.call @_QPsub(%[[VAL_8]], %[[VAL_7]]#1) fastmath : (!fir.ref>, !fir.ref) -> () +! CHECK: hlfir.end_associate %[[VAL_6]]#1, %[[VAL_6]]#2 : !fir.ref>, i1 +! CHECK: hlfir.end_associate %[[VAL_7]]#1, %[[VAL_7]]#2 : !fir.ref, i1 +! CHECK: return +! CHECK: }