[Flang] Make handling of %VAL consistent with gfortran

[ceseo]

Force an indirect call to the implicit signature in mustCastFuncOpToCopeWithImplicitInterfaceMismatch to make lowering consistent with gfortran.

[llvmbot]

@llvm/pr-subscribers-flang-fir-hlfir

Author: Carlos Seo (ceseo)

Changes

Force an indirect call to the implicit signature in mustCastFuncOpToCopeWithImplicitInterfaceMismatch to make lowering consistent with gfortran.

---

Full diff: https://github.com/llvm/llvm-project/pull/157873.diff

2 Files Affected:

• (modified) flang/lib/Lower/ConvertCall.cpp (+15-21)
• (modified) flang/test/Lower/percent-val-actual-argument.f90 (+4-1)

diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 0b5d4183c83d3..d3d27afc2ac7f 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -151,6 +151,17 @@ static bool mustCastFuncOpToCopeWithImplicitInterfaceMismatch(
       if (actualType != dummyType &&
           !fir::ConvertOp::canBeConverted(actualType, dummyType))
         return true;
+
+  // For %VAL arguments with implicit interfaces, we need to force an indirect
+  // call to ensure consistent behavior regardless of whether the procedure
+  // is defined in the same compilation unit or not. Check for mismatches
+  // where a by-value call site expects a reference type in the actual
+  // function definition.
+  for (auto [actualType, dummyType] :
+       llvm::zip(callSiteType.getInputs(), funcOpType.getInputs()))
+    if (!fir::isa_ref_type(actualType) && fir::isa_ref_type(dummyType) &&
+        fir::dyn_cast_ptrEleTy(dummyType) == actualType)
+      return true;
   return false;
 }
 
@@ -516,16 +527,8 @@ Fortran::lower::genCallOpAndResult(
     mlir::Value cast;
     auto *context = builder.getContext();
 
-    // 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())) {
+    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)) {
@@ -1668,17 +1671,8 @@ void prepareUserCallArguments(
         break;
       }
       // 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));
+      // conversion to reference types.
+      caller.placeInput(arg, builder.createConvert(loc, argTy, value));
 
     } break;
     case PassBy::BaseAddressValueAttribute:
diff --git a/flang/test/Lower/percent-val-actual-argument.f90 b/flang/test/Lower/percent-val-actual-argument.f90
index 890b1972e80bb..b4e635bef2887 100644
--- a/flang/test/Lower/percent-val-actual-argument.f90
+++ b/flang/test/Lower/percent-val-actual-argument.f90
@@ -6,7 +6,10 @@ program main
   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: %[[A1_LOADED:.*]] = fir.load %[[A1_DECL]]#0 : !fir.ref<!fir.logical<4>>
+! CHECK: %[[SA_ADDR:.*]] = fir.address_of(@_QPsa) : (!fir.ref<!fir.logical<4>>) -> ()
+! CHECK: %[[SA_CONVERT:.*]] = fir.convert %[[SA_ADDR]] : ((!fir.ref<!fir.logical<4>>) -> ()) -> ((!fir.logical<4>) -> ())
+! CHECK: fir.call %[[SA_CONVERT]](%[[A1_LOADED]]) fastmath<contract> : (!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

[jeanPerier]

Thanks, I think this is the right direction.

Since there is actually no code generation between fir.logical to fir.ref and vice versa, I think it would make sense to change the isIntegerCompatible here in fir::ConvertOp::canBeConverted to isInteger.

That way fir.convert between logical and pointer types will not be allowed and the code above will trigger the signature conversion. Except for integers, this is already what is happening with %VAL mismatch.

For the integer types, there is an intptr conversion that is inserted, which is admittedly slightly different than a function cast since it will zero out the upper register bits depending on the while they would be undefined with a function cast. I think this behavior is OK (zero is an acceptable value for something undefined) and is better to keep a single simple loop than to add more logic.

[ceseo]

Since there is actually no code generation between fir.logical to fir.ref and vice versa, I think it would make sense to change the isIntegerCompatible here in fir::ConvertOp::canBeConverted to isInteger.

Yes, I agree. Then we just need to remove the previous PR code from ConvertCall.cpp and it should work consistently for all cases.

[ceseo]

@jeanPerier ping? Any other comments?

[jeanPerier]

Looks great, thanks