diff --git a/flang/include/flang/Optimizer/Builder/Character.h b/flang/include/flang/Optimizer/Builder/Character.h --- a/flang/include/flang/Optimizer/Builder/Character.h +++ b/flang/include/flang/Optimizer/Builder/Character.h @@ -204,8 +204,8 @@ 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 --- a/flang/lib/Optimizer/Builder/Character.cpp +++ b/flang/lib/Optimizer/Builder/Character.cpp @@ -718,7 +718,10 @@ 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 --- /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 --- /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