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

[via flang-commits]

Author: PeixinQiao
Date: 2022-05-06T22:14:51+08:00
New Revision: ffc7f9d542370eb72ad1f4bf79f763ca685bab8b

URL: https://github.com/llvm/llvm-project/commit/ffc7f9d542370eb72ad1f4bf79f763ca685bab8b
DIFF: https://github.com/llvm/llvm-project/commit/ffc7f9d542370eb72ad1f4bf79f763ca685bab8b.diff

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

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.

Reviewed By: Jean Perier, klausler

Differential Revision: https://reviews.llvm.org/D124345

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

Modified: 
    flang/include/flang/Optimizer/Builder/Character.h
    flang/lib/Optimizer/Builder/Character.cpp

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Optimizer/Builder/Character.h b/flang/include/flang/Optimizer/Builder/Character.h
index e64a7044aec8c..8b952620d1fdd 100644
--- a/flang/include/flang/Optimizer/Builder/Character.h
+++ b/flang/include/flang/Optimizer/Builder/Character.h
@@ -204,8 +204,8 @@ class CharacterExprHelper {
 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,

diff  --git a/flang/lib/Optimizer/Builder/Character.cpp b/flang/lib/Optimizer/Builder/Character.cpp
index 4a90a697aca51..c025270cf83ea 100644
--- a/flang/lib/Optimizer/Builder/Character.cpp
+++ b/flang/lib/Optimizer/Builder/Character.cpp
@@ -718,7 +718,10 @@ mlir::Value fir::factory::createCharacterProcedureTuple(
     mlir::Value addr, mlir::Value len) {
   mlir::TupleType tupleType = argTy.cast<mlir::TupleType>();
   addr = builder.createConvert(loc, tupleType.getType(0), addr);
-  len = builder.createConvert(loc, tupleType.getType(1), len);
+  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,

diff  --git a/flang/test/Lower/ext-proc-as-actual-argument-1.f90 b/flang/test/Lower/ext-proc-as-actual-argument-1.f90
new file mode 100644
index 0000000000000..e121a82a3e021
--- /dev/null
+++ b/flang/test/Lower/ext-proc-as-actual-argument-1.f90
@@ -0,0 +1,31 @@
+! 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

diff  --git a/flang/test/Lower/ext-proc-as-actual-argument-2.f90 b/flang/test/Lower/ext-proc-as-actual-argument-2.f90
new file mode 100644
index 0000000000000..8c04e8617f49e
--- /dev/null
+++ b/flang/test/Lower/ext-proc-as-actual-argument-2.f90
@@ -0,0 +1,31 @@
+! 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