[flang] Fix the trivial type passed as value with bind(C)

[peixin]

Summary

In the callee side, the value cannot be used directly. For example, the
dummy argument is lhs variable or the dummy argument is passed to
another procedure as actual argument.

Fix this by allocating one temporary storage and store the value. Then
map the symbol of dummy argument to the mlir::Value of the temporary.

[peixin]

Fix one code-style problem.

[jeanPerier]

I think BIND(C) VALUE arrays should hit a compile time error, otherwise looks good to me.

flang/test/Lower/call-by-value.f90

86

I think array dummy arguments with VALUE in BIND(C) interface may be illegal. My rational is that 18.3.6 does not list them as something allowed in a BIND(C) interface. I am surprised the standard to has not been more explicit about this in 8.5.18 (adding it to C865 for instance).

gfortran, nvfortran, xlf, and ifort all raise compile time errors here.

I would be inclined to add a fatal error in lowering instead of supporting it and adding a test until a proper semantic check is added.

I think a more cryptic lowering error is most likely hit for the following anyway:

subroutine test_integer_array_value(x, n) bind(c)
  integer :: n
  integer, value :: x(n)
end

[peixin]

Remove the array support.

flang/test/Lower/call-by-value.f90

86

Thanks. I agree with you. Fixed.

[jeanPerier]

Thanks, looks good !

flang/lib/Lower/Bridge.cpp

void mapCPtrArgByValue(const Fortran::semantics::Symbol &sym,
     mlir::Value resAddr =
         fir::factory::genCPtrOrCFunptrAddr(*builder, loc, res, symTy);
     mlir::Value argAddrVal =
         builder->createConvert(loc, fir::unwrapRefType(resAddr.getType()), val);
     builder->create<fir::StoreOp>(loc, argAddrVal, resAddr);
     addSymbol(sym, res);
   }
 
+  void mapTrivialByValue(const Fortran::semantics::Symbol &sym,
+                         mlir::Value val) {
+    mlir::Location loc = toLocation();
+    mlir::Value res = builder->create<fir::AllocaOp>(loc, val.getType());
+    builder->create<fir::StoreOp>(loc, val, res);
+    addSymbol(sym, res);
+  }
+
   /// Map mlir function block arguments to the corresponding Fortran dummy
   /// variables. When the result is passed as a hidden argument, the Fortran
   /// result is also mapped. The symbol map is used to hold this mapping.
   void mapDummiesAndResults(Fortran::lower::pft::FunctionLikeUnit &funit,
                             const Fortran::lower::CalleeInterface &callee) {
     assert(builder && "require a builder object at this point");
     using PassBy = Fortran::lower::CalleeInterface::PassEntityBy;
     auto mapPassedEntity = [&](const auto arg) {
auto mapPassedEntity = [&](const auto arg) {
             mlir::Type argTy = arg.firArgument.getType();
             if (argTy.isa<fir::RecordType>())
               TODO(toLocation(), "derived type argument passed by value");
             if (Fortran::semantics::IsBuiltinCPtr(arg.entity->get()) &&
                 Fortran::lower::isCPtrArgByValueType(argTy)) {
               mapCPtrArgByValue(arg.entity->get(), arg.firArgument);
               return;
             }
+            if (fir::isa_trivial(argTy) || argTy.isa<fir::SequenceType>()) {
+              mapTrivialByValue(arg.entity->get(), arg.firArgument);
+              return;
+            }
           }
           addSymbol(arg.entity->get(), arg.firArgument);
         } else {
           assert(funit.parentHasHostAssoc());
           funit.parentHostAssoc().internalProcedureBindings(*this,
                                                             localSymbols);
         }
       }

flang/lib/Lower/CallInterface.cpp

if (obj.attrs.test(Attrs::Allocatable) || obj.attrs.test(Attrs::Pointer)) {
                    entity, characteristics);
     } else {
       // Pass as fir.ref unless it's by VALUE and BIND(C)
       mlir::Type passType = fir::ReferenceType::get(type);
       PassEntityBy passBy = PassEntityBy::BaseAddress;
       Property prop = Property::BaseAddress;
       if (isValueAttr) {
         if (isBindC) {
+          // FIXME: array may not always be passed as Value. This needs more
+          // investigations.
           passBy = PassEntityBy::Value;
           prop = Property::Value;
           if (fir::isa_builtin_cptr_type(type)) {
             auto recTy = type.dyn_cast<fir::RecordType>();
             mlir::Type fieldTy = recTy.getTypeList()[0].second;
             passType = fir::ReferenceType::get(fieldTy);
           } else {
             passType = type;

flang/test/Lower/call-by-value.f90

 ! Test for PassBy::Value
 ! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+!CHECK-LABEL: func @_QQmain()
+!CHECK: %[[LOGICAL:.*]] = fir.alloca !fir.logical<4>
+!CHECK: %false = arith.constant false
+!CHECK: %[[VALUE:.*]] = fir.convert %false : (i1) -> !fir.logical<4>
+!CHECK: fir.store %[[VALUE]] to %[[LOGICAL]]
+!CHECK: %[[LOAD:.*]] = fir.load %[[LOGICAL]]
+!CHECK: fir.call @omp_set_nested(%[[LOAD]]) : {{.*}}
+
 program call_by_value
   interface
      subroutine omp_set_nested(enable) bind(c)
        logical, value :: enable
      end subroutine omp_set_nested
   end interface
 
   logical do_nested
   do_nested = .FALSE.
   call omp_set_nested(do_nested)
 end program call_by_value
-!CHECK-LABEL: func @_QQmain()
-!CHECK: %[[LOGICAL:.*]] = fir.alloca !fir.logical<4>
-!CHECK: %false = arith.constant false
-!CHECK: %[[VALUE:.*]] = fir.convert %false : (i1) -> !fir.logical<4>
-!CHECK: fir.store %[[VALUE]] to %[[LOGICAL]]
-!CHECK: %[[LOAD:.*]] = fir.load %[[LOGICAL]]
-!CHECK: fir.call @omp_set_nested(%[[LOAD]]) : {{.*}}
+
+! CHECK-LABEL: func.func @test_integer_value(
+! CHECK-SAME:                                %[[VAL_0:.*]]: i32 {fir.bindc_name = "x"}) attributes {fir.bindc_name = "test_integer_value"} {
+! CHECK:         %[[VAL_1:.*]] = fir.alloca i32
+! CHECK:         fir.store %[[VAL_0]] to %[[VAL_1]] : !fir.ref<i32>
+! CHECK:         fir.call @_QPinternal_call(%[[VAL_1]]) : (!fir.ref<i32>) -> ()
+! CHECK:         return
+! CHECK:       }
+
+subroutine test_integer_value(x) bind(c)
+  integer, value :: x
+  call internal_call(x)
+end
+
+! CHECK-LABEL: func.func @test_real_value(
+! CHECK-SAME:                             %[[VAL_0:.*]]: f32 {fir.bindc_name = "x"}) attributes {fir.bindc_name = "test_real_value"} {
+! CHECK:         %[[VAL_1:.*]] = fir.alloca f32
+! CHECK:         fir.store %[[VAL_0]] to %[[VAL_1]] : !fir.ref<f32>
+! CHECK:         fir.call @_QPinternal_call2(%[[VAL_1]]) : (!fir.ref<f32>) -> ()
+! CHECK:         return
+! CHECK:       }
+
+subroutine test_real_value(x) bind(c)
+  real, value :: x
+  call internal_call2(x)
+end
+
+! CHECK-LABEL: func.func @test_complex_value(
+! CHECK-SAME:                                %[[VAL_0:.*]]: !fir.complex<4> {fir.bindc_name = "x"}) attributes {fir.bindc_name = "test_complex_value"} {
+! CHECK:         %[[VAL_1:.*]] = fir.alloca !fir.complex<4>
+! CHECK:         fir.store %[[VAL_0]] to %[[VAL_1]] : !fir.ref<!fir.complex<4>>
+! CHECK:         fir.call @_QPinternal_call3(%[[VAL_1]]) : (!fir.ref<!fir.complex<4>>) -> ()
+! CHECK:         return
+! CHECK:       }
+
+subroutine test_complex_value(x) bind(c)
+  complex, value :: x
+  call internal_call3(x)
+end
+
+! CHECK-LABEL: func.func @test_char_value(
+! CHECK-SAME:                             %[[VAL_0:.*]]: !fir.boxchar<1> {fir.bindc_name = "x"}) attributes {fir.bindc_name = "test_char_value"} {
+! CHECK:         %[[VAL_1:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK:         %[[VAL_2:.*]] = arith.constant 1 : index
+! CHECK:         %[[VAL_3:.*]] = fir.emboxchar %[[VAL_1]]#0, %[[VAL_2]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK:         fir.call @_QPinternal_call4(%[[VAL_3]]) : (!fir.boxchar<1>) -> ()
+! CHECK:         return
+! CHECK:       }
+
+subroutine test_char_value(x) bind(c)
+  character(1), value :: x
+  call internal_call4(x)
+end
+
+! CHECK-LABEL: func.func @test_integer_array_value(
+! CHECK-SAME:                                      %[[VAL_0:.*]]: !fir.array<2xi32> {fir.bindc_name = "x"}) attributes {fir.bindc_name = "test_integer_array_value"} {
+! CHECK:         %[[VAL_1:.*]] = fir.alloca !fir.array<2xi32>
+! CHECK:         fir.store %[[VAL_0]] to %[[VAL_1]] : !fir.ref<!fir.array<2xi32>>
+! CHECK:         fir.call @_QPinternal_call5(%[[VAL_1]]) : (!fir.ref<!fir.array<2xi32>>) -> ()
+! CHECK:         return
+! CHECK:       }
+
+subroutine test_integer_array_value(x) bind(c)
+  integer, value :: x(2)
+  call internal_call5(x)
+end

flang/test/Lower/call.f90

function f_int_to_char(i) bind(c, name="f_int_to_char")
   character(kind=c_char) :: f_int_to_char
   integer(c_int), value :: i
   f_int_to_char = char(i)
 end function
 
 ! CHECK-LABEL: func.func @f_int_to_char(
 ! CHECK-SAME: %[[ARG0:.*]]: i32 {fir.bindc_name = "i"}) -> !fir.char<1> attributes {fir.bindc_name = "f_int_to_char"} {
 ! CHECK: %[[CHARBOX:.*]] = fir.alloca !fir.char<1> {adapt.valuebyref}
+! CHECK: %[[INT_I:.*]] = fir.alloca i32
+! CHECK: fir.store %[[ARG0]] to %[[INT_I]] : !fir.ref<i32>
 ! CHECK: %[[RESULT:.*]] = fir.alloca !fir.char<1> {bindc_name = "f_int_to_char", uniq_name = "_QFf_int_to_charEf_int_to_char"}
-! CHECK: %[[ARG0_I64:.*]] = fir.convert %[[ARG0]] : (i32) -> i64
+! CHECK: %[[ARG0_2:.*]] = fir.load %[[INT_I]] : !fir.ref<i32>
+! CHECK: %[[ARG0_I64:.*]] = fir.convert %[[ARG0_2]] : (i32) -> i64
 ! CHECK: %[[ARG0_I8:.*]] = fir.convert %[[ARG0_I64]] : (i64) -> i8
 ! CHECK: %[[UNDEF:.*]] = fir.undefined !fir.char<1>
-! CHECK: %[[CHAR_RES:.*]] = fir.insert_value %4, %3, [0 : index] : (!fir.char<1>, i8) -> !fir.char<1>
+! CHECK: %[[CHAR_RES:.*]] = fir.insert_value %[[UNDEF]], %[[ARG0_I8]], [0 : index] : (!fir.char<1>, i8) -> !fir.char<1>
 ! CHECK: fir.store %[[CHAR_RES]] to %[[CHARBOX]] : !fir.ref<!fir.char<1>>
 ! CHECK: %[[LOAD_CHARBOX:.*]] = fir.load %[[CHARBOX]] : !fir.ref<!fir.char<1>>
 ! CHECK: fir.store %[[LOAD_CHARBOX]] to %[[RESULT]] : !fir.ref<!fir.char<1>>
 ! CHECK: %[[LOAD_RES:.*]] = fir.load %[[RESULT]] : !fir.ref<!fir.char<1>>
 ! CHECK: return %[[LOAD_RES]] : !fir.char<1>