[flang] Support external procedure passed as actual argument with implicit character type

[peixin]

Summary

As Fortran 2018 15.5.2.9 point 2, the actual argument and dummy argument
have the same type and type parameters and an external function with
assumed character length may be associated with a dummy argument with
explicit character length. As Fortran 2018 15.5.2.9 point 7, if an
external procedure is used as an actual argument, it can be explicitly
declared to have the EXTERNAL attribute. This supports the external
procedure passed as actual argument with implicit character type, either
explicit character length or assumed character length.

[peixin]

ping

[jeanPerier]

flang/lib/Optimizer/Builder/Character.cpp

721–724

Can you document in the in the header file that len may be a null Value in createCharacterProcedureTuple ?

flang/test/Lower/ext-proc-as-actual-argument-1.f90

20

I do not think this is a valid program since ext_func is implicitly typed in m, so it is not known to be an "external function with assumed character length" from a Fortran compiler. Ifort actually reject the program.

That being said, gfortran seems to support this, and if we do not want to allow this, we should at least block this in semantics. So something needs to be done, thanks for making this patch.

@peixin, are you adding support for this case because some existing Fortran code is doing this ?

@klausler, I think it is reasonable to support this case, do you agree ?

[peixin]

flang/test/Lower/ext-proc-as-actual-argument-1.f90

20

I do not think this is a valid program since ext_func is implicitly typed in m, so it is not known to be an "external function with assumed character length" from a Fortran compiler. Ifort actually reject the program.

Thanks for correcting me. I think you are right. I forgot to check ifort, which did give the following error:

test.f90(7): error #6633: The type of the actual argument differs from the type of the dummy argument.   [EXT_FUNC]
  call sub(ext_func)

This seems not to be correct. ext_func is implicitly typed to be the same type as dummy argument.

are you adding support for this case because some existing Fortran code is doing this ?

This test case is not from workloads. When I learn FIR lowering, I take in test cases in classic-flang, gfortran, or randomly searched online, or our internal test cases. And sometimes, I add or delete some components from those test cases. So, this is one mixed test case.

[klausler]

I concur, this case should work.

[peixin]

Addressed the comments.

1. Add changes to the header file.
2. Change the descriptions in title, summary, and test cases.

character type -> implicit character type

[jeanPerier]

Thanks

flang/include/flang/Optimizer/Builder/Character.h

 //===----------------------------------------------------------------------===//
 
 /// Create a tuple<function type, length type> type to pass character functions
 /// as arguments along their length. The function type set in the tuple is the
 /// one provided by \p funcPointerType.
 mlir::Type getCharacterProcedureTupleType(mlir::Type funcPointerType);
 
 /// Create a tuple<addr, len> given \p addr and \p len as well as the tuple
-/// type \p argTy. \p addr must be any function address, and \p len must be
-/// any integer. Converts will be inserted if needed if \addr and \p len
+/// type \p argTy. \p addr must be any function address, and \p len may be any
+/// integer or nullptr. Converts will be inserted if needed if \addr and \p len
 /// types are not the same as the one inside the tuple type \p tupleType.
 mlir::Value createCharacterProcedureTuple(fir::FirOpBuilder &builder,
                                           mlir::Location loc,
                                           mlir::Type tupleType,
                                           mlir::Value addr, mlir::Value len);
 
 /// Given a tuple containing a character function address and its result length,
 /// extract the tuple into a pair of value <function address, result length>.
 std::pair<mlir::Value, mlir::Value>
 extractCharacterProcedureTuple(fir::FirOpBuilder &builder, mlir::Location loc,
                                mlir::Value tuple);
 
 } // namespace fir::factory
 
 #endif // FORTRAN_OPTIMIZER_BUILDER_CHARACTER_H

flang/lib/Optimizer/Builder/Character.cpp

fir::factory::extractCharacterProcedureTuple(fir::FirOpBuilder &builder,
   return {proc, len};
 }
 
 mlir::Value fir::factory::createCharacterProcedureTuple(
     fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type argTy,
     mlir::Value addr, mlir::Value len) {
   mlir::TupleType tupleType = argTy.cast<mlir::TupleType>();
   addr = builder.createConvert(loc, tupleType.getType(0), addr);
+  if (len)
     len = builder.createConvert(loc, tupleType.getType(1), len);
+  else
+    len = builder.create<fir::UndefOp>(loc, tupleType.getType(1));
   mlir::Value tuple = builder.create<fir::UndefOp>(loc, tupleType);
   tuple = builder.create<fir::InsertValueOp>(
       loc, tupleType, tuple, addr,
       builder.getArrayAttr(
           {builder.getIntegerAttr(builder.getIndexType(), 0)}));
   tuple = builder.create<fir::InsertValueOp>(
       loc, tupleType, tuple, len,
       builder.getArrayAttr(

flang/test/Lower/ext-proc-as-actual-argument-1.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! Test external procedure as actual argument with the implicit character type.
+
+! CHECK-LABEL: func @_QQmain
+! CHECK:  %[[VAL_0:.*]] = fir.address_of(@_QPext_func) : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK:  %[[VAL_1:.*]] = fir.emboxproc %[[VAL_0]] : ((!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>) -> !fir.boxproc<() -> ()>
+! CHECK:  %[[VAL_2:.*]] = fir.undefined i64
+! CHECK:  %[[VAL_3:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK:  %[[VAL_4:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_1]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK:  %[[VAL_5:.*]] = fir.insert_value %[[VAL_4]], %[[VAL_2]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK:  fir.call @_QFPsub(%[[VAL_5]]) : (tuple<!fir.boxproc<() -> ()>, i64>) -> ()
+! CHECK:  return
+
+! CHECK-LABEL: func @_QPext_func(
+! CEHCK: %[[ARG_0:.*]]: !fir.ref<!fir.char<1,?>>, %[[ARG_1:.*]]: index) -> !fir.boxchar<1> {
+program m
+  external :: ext_func
+  call sub(ext_func)
+
+contains
+  subroutine sub(arg)
+    character(20), external :: arg
+    print *, arg()
+  end
+end
+
+function ext_func() result(res)
+  character(*) res
+  res = "hello world"
+end

flang/test/Lower/ext-proc-as-actual-argument-2.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! Test external procedure as actual argument with the implicit character type.
+
+! CHECK-LABEL: func @_QQmain
+! CHECK:  %[[VAL_0:.*]] = fir.address_of(@_QPext_func) : (!fir.ref<!fir.char<1,20>>, index) -> !fir.boxchar<1>
+! CHECK:  %[[VAL_1:.*]] = fir.emboxproc %[[VAL_0]] : ((!fir.ref<!fir.char<1,20>>, index) -> !fir.boxchar<1>) -> !fir.boxproc<() -> ()>
+! CHECK:  %[[VAL_2:.*]] = fir.undefined i64
+! CHECK:  %[[VAL_3:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK:  %[[VAL_4:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_1]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK:  %[[VAL_5:.*]] = fir.insert_value %[[VAL_4]], %[[VAL_2]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK:  fir.call @_QFPsub(%[[VAL_5]]) : (tuple<!fir.boxproc<() -> ()>, i64>) -> ()
+! CHECK:  return
+
+! CHECK-LABEL: func @_QPext_func(
+! CEHCK: %[[ARG_0:.*]]: !fir.ref<!fir.char<1,20>>, %[[ARG_1:.*]]: index) -> !fir.boxchar<1> {
+program m
+  external :: ext_func
+  call sub(ext_func)
+
+contains
+  subroutine sub(arg)
+    character(20), external :: arg
+    print *, arg()
+  end
+end
+
+function ext_func() result(res)
+  character(20) res
+  res = "hello world"
+end