From ffc7f9d542370eb72ad1f4bf79f763ca685bab8b Mon Sep 17 00:00:00 2001 From: PeixinQiao Date: Fri, 6 May 2022 22:14:51 +0800 Subject: [PATCH] [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 --- flang/include/flang/Optimizer/Builder/Character.h | 4 +-- flang/lib/Optimizer/Builder/Character.cpp | 5 +++- flang/test/Lower/ext-proc-as-actual-argument-1.f90 | 31 ++++++++++++++++++++++ flang/test/Lower/ext-proc-as-actual-argument-2.f90 | 31 ++++++++++++++++++++++ 4 files changed, 68 insertions(+), 3 deletions(-) create mode 100644 flang/test/Lower/ext-proc-as-actual-argument-1.f90 create mode 100644 flang/test/Lower/ext-proc-as-actual-argument-2.f90 diff --git a/flang/include/flang/Optimizer/Builder/Character.h b/flang/include/flang/Optimizer/Builder/Character.h index e64a704..8b95262 100644 --- a/flang/include/flang/Optimizer/Builder/Character.h +++ b/flang/include/flang/Optimizer/Builder/Character.h @@ -204,8 +204,8 @@ private: mlir::Type getCharacterProcedureTupleType(mlir::Type funcPointerType); /// Create a tuple 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 4a90a69..c025270 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(); 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(loc, tupleType.getType(1)); mlir::Value tuple = builder.create(loc, tupleType); tuple = builder.create( 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 0000000..e121a82 --- /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>, index) -> !fir.boxchar<1> +! CHECK: %[[VAL_1:.*]] = fir.emboxproc %[[VAL_0]] : ((!fir.ref>, index) -> !fir.boxchar<1>) -> !fir.boxproc<() -> ()> +! CHECK: %[[VAL_2:.*]] = fir.undefined i64 +! CHECK: %[[VAL_3:.*]] = fir.undefined tuple ()>, i64> +! CHECK: %[[VAL_4:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_1]], [0 : index] : (tuple ()>, i64>, !fir.boxproc<() -> ()>) -> tuple ()>, i64> +! CHECK: %[[VAL_5:.*]] = fir.insert_value %[[VAL_4]], %[[VAL_2]], [1 : index] : (tuple ()>, i64>, i64) -> tuple ()>, i64> +! CHECK: fir.call @_QFPsub(%[[VAL_5]]) : (tuple ()>, i64>) -> () +! CHECK: return + +! CHECK-LABEL: func @_QPext_func( +! CEHCK: %[[ARG_0:.*]]: !fir.ref>, %[[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 0000000..8c04e86 --- /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>, index) -> !fir.boxchar<1> +! CHECK: %[[VAL_1:.*]] = fir.emboxproc %[[VAL_0]] : ((!fir.ref>, index) -> !fir.boxchar<1>) -> !fir.boxproc<() -> ()> +! CHECK: %[[VAL_2:.*]] = fir.undefined i64 +! CHECK: %[[VAL_3:.*]] = fir.undefined tuple ()>, i64> +! CHECK: %[[VAL_4:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_1]], [0 : index] : (tuple ()>, i64>, !fir.boxproc<() -> ()>) -> tuple ()>, i64> +! CHECK: %[[VAL_5:.*]] = fir.insert_value %[[VAL_4]], %[[VAL_2]], [1 : index] : (tuple ()>, i64>, i64) -> tuple ()>, i64> +! CHECK: fir.call @_QFPsub(%[[VAL_5]]) : (tuple ()>, i64>) -> () +! CHECK: return + +! CHECK-LABEL: func @_QPext_func( +! CEHCK: %[[ARG_0:.*]]: !fir.ref>, %[[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 -- 2.7.4