[Flang] Handle %VAL arguments correctly (#157186)

Internal procedures expect reference parameters. However, when %VAL is
used, the argument should be passed by value. Forward the loaded address
and skip conversion to avoid a type conversion error.

Fixes #118239

Author: ceseo

flang/lib/Lower/ConvertCall.cpp

@@ -515,10 +515,19 @@ Fortran::lower::genCallOpAndResult(
     // arguments of any type and vice versa.
     mlir::Value cast;
     auto *context = builder.getContext();
-    if (mlir::isa<fir::BoxProcType>(snd) &&
-        mlir::isa<mlir::FunctionType>(fst.getType())) {
-      auto funcTy = mlir::FunctionType::get(context, {}, {});
-      auto boxProcTy = builder.getBoxProcType(funcTy);
+
+    // Special handling for %VAL arguments: internal procedures expect
+    // reference parameters. When %VAL is used, the argument should be
+    // passed by value. Pass the originally loaded value.
+    if (fir::isa_ref_type(snd) && !fir::isa_ref_type(fst.getType()) &&
+        fir::dyn_cast_ptrEleTy(snd) == fst.getType()) {
+      auto loadOp = mlir::cast<fir::LoadOp>(fst.getDefiningOp());
+      mlir::Value originalStorage = loadOp.getMemref();
+      cast = originalStorage;
+    } else if (mlir::isa<fir::BoxProcType>(snd) &&
+               mlir::isa<mlir::FunctionType>(fst.getType())) {
+      mlir::FunctionType funcTy = mlir::FunctionType::get(context, {}, {});
+      fir::BoxProcType boxProcTy = builder.getBoxProcType(funcTy);
       if (mlir::Value host = argumentHostAssocs(converter, fst)) {
         cast = fir::EmboxProcOp::create(builder, loc, boxProcTy,
                                         llvm::ArrayRef<mlir::Value>{fst, host});
@@ -1658,7 +1667,19 @@ void prepareUserCallArguments(
           (*cleanup)();
         break;
       }
-      caller.placeInput(arg, builder.createConvert(loc, argTy, value));
+      // For %VAL arguments, we should pass the value directly without
+      // conversion to reference types. If argTy is different from value type,
+      // it might be due to signature mismatch with internal procedures.
+      if (argTy == value.getType())
+        caller.placeInput(arg, value);
+      else if (fir::isa_ref_type(argTy) &&
+               fir::dyn_cast_ptrEleTy(argTy) == value.getType()) {
+        auto loadOp = mlir::cast<fir::LoadOp>(value.getDefiningOp());
+        mlir::Value originalStorage = loadOp.getMemref();
+        caller.placeInput(arg, originalStorage);
+      } else
+        caller.placeInput(arg, builder.createConvert(loc, argTy, value));
+
     } break;
     case PassBy::BaseAddressValueAttribute:
     case PassBy::CharBoxValueAttribute:

flang/test/Lower/percent-val-actual-argument.f90

@@ -0,0 +1,16 @@
+! RUN: flang -fc1 -emit-hlfir %s -o - | FileCheck %s
+
+program main
+  logical::a1
+  data a1/.true./
+  call sa(%val(a1))
+! CHECK: %[[A1_ADDR:.*]] = fir.address_of(@_QFEa1) : !fir.ref<!fir.logical<4>>
+! CHECK: %[[A1_DECL:.*]]:2 = hlfir.declare %[[A1_ADDR]] {uniq_name = "_QFEa1"} : (!fir.ref<!fir.logical<4>>) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>)
+! CHECK: fir.call @_QPsa(%[[A1_DECL]]#0) fastmath<contract> : (!fir.ref<!fir.logical<4>>) -> ()
+! CHECK: func.func @_QPsa(%[[SA_ARG:.*]]: !fir.ref<!fir.logical<4>> {fir.bindc_name = "x1"}) {
+  write(6,*) "a1 = ", a1
+end program main
+
+subroutine sa(x1)
+  logical::x1
+end subroutine sa

flang/test/Lower/percent-val-value-argument.f90

@@ -0,0 +1,17 @@
+! RUN: flang -fc1 -emit-hlfir %s -o - | FileCheck %s
+
+program main
+  logical::a1
+  data a1/.true./
+  call sb(%val(a1))
+! CHECK: %[[A1_ADDR:.*]] = fir.address_of(@_QFEa1) : !fir.ref<!fir.logical<4>>
+! CHECK: %[[A1_DECL:.*]]:2 = hlfir.declare %[[A1_ADDR]] {uniq_name = "_QFEa1"} : (!fir.ref<!fir.logical<4>>) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>)
+! CHECK: %[[A1_LOADED:.*]] = fir.load %[[A1_DECL]]#0 : !fir.ref<!fir.logical<4>>
+! CHECK: fir.call @_QFPsb(%[[A1_LOADED]]) fastmath<contract> : (!fir.logical<4>) -> ()
+! CHECK: func.func private @_QFPsb(%[[SB_ARG:.*]]: !fir.logical<4> {fir.bindc_name = "x1"})
+  write(6,*) "a1 = ", a1
+contains
+  subroutine sb(x1)
+    logical, value :: x1
+  end subroutine sb
+end program main