[flang] [llvm] [flang] Implement 'F_C_STRING' library function (Fortran 2023) (PR #174474)
Caroline Newcombe via llvm-commits
llvm-commits at lists.llvm.org
Mon Feb 9 08:43:18 PST 2026
https://github.com/cenewcombe updated https://github.com/llvm/llvm-project/pull/174474
>From f2f5aea6b3735a90207dc16e8d1a2330ba4969ac Mon Sep 17 00:00:00 2001
From: Caroline Newcombe <caroline.newcombe at hpe.com>
Date: Wed, 17 Dec 2025 15:04:20 -0600
Subject: [PATCH 1/9] [flang] Implement 'F_C_STRING' library function (Fortran
2023)
---
flang-rt/lib/runtime/CMakeLists.txt | 1 +
flang/module/iso_c_binding.f90 | 16 ++++++-
flang/test/Integration/f_c_string.f90 | 60 +++++++++++++++++++++++++++
3 files changed, 76 insertions(+), 1 deletion(-)
create mode 100644 flang/test/Integration/f_c_string.f90
diff --git a/flang-rt/lib/runtime/CMakeLists.txt b/flang-rt/lib/runtime/CMakeLists.txt
index 7fa8c2cb95417..d18f24e6c786a 100644
--- a/flang-rt/lib/runtime/CMakeLists.txt
+++ b/flang-rt/lib/runtime/CMakeLists.txt
@@ -75,6 +75,7 @@ set(supported_sources
# List of source not used for GPU offloading.
set(host_sources
${FLANG_SOURCE_DIR}/module/iso_fortran_env_impl.f90
+ ${FLANG_SOURCE_DIR}/module/iso_c_binding.f90
command.cpp
complex-powi.cpp
complex-reduction.c
diff --git a/flang/module/iso_c_binding.f90 b/flang/module/iso_c_binding.f90
index 8e3f78cea51b7..34e7b6280f54d 100644
--- a/flang/module/iso_c_binding.f90
+++ b/flang/module/iso_c_binding.f90
@@ -29,7 +29,7 @@ module iso_c_binding
private
public :: c_associated, c_funloc, c_funptr, c_f_pointer, c_loc, &
- c_null_funptr, c_null_ptr, c_ptr, c_sizeof, &
+ c_null_funptr, c_null_ptr, c_ptr, c_sizeof, f_c_string, &
operator(==), operator(/=)
! Table 18.2 (in clause 18.3.1)
@@ -145,4 +145,18 @@ subroutine c_f_procpointer(cptr, fptr)
! TODO: implement
end subroutine c_f_procpointer
+ ! F_C_STRING - Convert Fortran string to C null-terminated string
+ ! Fortran 2023 standard intrinsic
+ pure function f_c_string(string, asis) result(res)
+ character(kind=c_char, len=*), intent(in) :: string
+ logical, optional, intent(in) :: asis
+ character(kind=c_char, len=:), allocatable :: res
+
+ if (present(asis) .and. asis) then
+ res = string // c_null_char
+ else
+ res = trim(string) // c_null_char
+ end if
+ end function f_c_string
+
end module iso_c_binding
diff --git a/flang/test/Integration/f_c_string.f90 b/flang/test/Integration/f_c_string.f90
new file mode 100644
index 0000000000000..79ac10556a740
--- /dev/null
+++ b/flang/test/Integration/f_c_string.f90
@@ -0,0 +1,60 @@
+! RUN: %flang %s -o %t && %t | FileCheck %s
+! Test F_C_STRING library function
+
+program test_f_c_string
+ use iso_c_binding
+ implicit none
+
+ character(len=20) :: str
+ character(len=:), allocatable :: result
+ logical :: flag
+
+ ! Test 1: Basic trimming
+ str = 'hello '
+ result = f_c_string(str(1:10))
+ ! CHECK: Test 1: 6
+ print '(A,I0)', 'Test 1: ', len(result)
+ if (result /= 'hello' // c_null_char) error stop 'Test 1 failed'
+
+ ! Test 2: ASIS=.TRUE. (keep blanks)
+ result = f_c_string(str(1:10), .true.)
+ ! CHECK: Test 2: 11
+ print '(A,I0)', 'Test 2: ', len(result)
+ if (result /= 'hello ' // c_null_char) error stop 'Test 2 failed'
+
+ ! Test 3: ASIS=.FALSE. (explicit trim)
+ result = f_c_string(str(1:10), .false.)
+ ! CHECK: Test 3: 6
+ print '(A,I0)', 'Test 3: ', len(result)
+ if (result /= 'hello' // c_null_char) error stop 'Test 3 failed'
+
+ ! Test 4: Variable ASIS
+ flag = .true.
+ str = 'abc '
+ result = f_c_string(str(1:6), flag)
+ ! CHECK: Test 4: 7
+ print '(A,I0)', 'Test 4: ', len(result)
+ if (len(result) /= 7) error stop 'Test 4 failed'
+
+ flag = .false.
+ result = f_c_string(str(1:6), flag)
+ ! CHECK: Test 5: 4
+ print '(A,I0)', 'Test 5: ', len(result)
+ if (len(result) /= 4) error stop 'Test 5 failed'
+
+ ! Test 6: Empty (all blanks)
+ result = f_c_string(' ')
+ ! CHECK: Test 6: 1
+ print '(A,I0)', 'Test 6: ', len(result)
+ if (result /= c_null_char) error stop 'Test 6 failed'
+
+ ! Test 7: Internal blanks preserved
+ result = f_c_string('a b c ')
+ ! CHECK: Test 7: 6
+ print '(A,I0)', 'Test 7: ', len(result)
+ if (result /= 'a b c' // c_null_char) error stop 'Test 7 failed'
+
+ ! CHECK: PASS
+ print *, 'PASS'
+
+end program test_f_c_string
>From 591e313705af038d255a03144c50f9ceae08b915 Mon Sep 17 00:00:00 2001
From: Caroline Newcombe <caroline.newcombe at hpe.com>
Date: Tue, 6 Jan 2026 11:37:21 -0600
Subject: [PATCH 2/9] Swap the integration test for semantics checking, due to
testing limitations
---
flang/test/Integration/f_c_string.f90 | 60 ---------------------------
flang/test/Semantics/f_c_string.f90 | 39 +++++++++++++++++
2 files changed, 39 insertions(+), 60 deletions(-)
delete mode 100644 flang/test/Integration/f_c_string.f90
create mode 100644 flang/test/Semantics/f_c_string.f90
diff --git a/flang/test/Integration/f_c_string.f90 b/flang/test/Integration/f_c_string.f90
deleted file mode 100644
index 79ac10556a740..0000000000000
--- a/flang/test/Integration/f_c_string.f90
+++ /dev/null
@@ -1,60 +0,0 @@
-! RUN: %flang %s -o %t && %t | FileCheck %s
-! Test F_C_STRING library function
-
-program test_f_c_string
- use iso_c_binding
- implicit none
-
- character(len=20) :: str
- character(len=:), allocatable :: result
- logical :: flag
-
- ! Test 1: Basic trimming
- str = 'hello '
- result = f_c_string(str(1:10))
- ! CHECK: Test 1: 6
- print '(A,I0)', 'Test 1: ', len(result)
- if (result /= 'hello' // c_null_char) error stop 'Test 1 failed'
-
- ! Test 2: ASIS=.TRUE. (keep blanks)
- result = f_c_string(str(1:10), .true.)
- ! CHECK: Test 2: 11
- print '(A,I0)', 'Test 2: ', len(result)
- if (result /= 'hello ' // c_null_char) error stop 'Test 2 failed'
-
- ! Test 3: ASIS=.FALSE. (explicit trim)
- result = f_c_string(str(1:10), .false.)
- ! CHECK: Test 3: 6
- print '(A,I0)', 'Test 3: ', len(result)
- if (result /= 'hello' // c_null_char) error stop 'Test 3 failed'
-
- ! Test 4: Variable ASIS
- flag = .true.
- str = 'abc '
- result = f_c_string(str(1:6), flag)
- ! CHECK: Test 4: 7
- print '(A,I0)', 'Test 4: ', len(result)
- if (len(result) /= 7) error stop 'Test 4 failed'
-
- flag = .false.
- result = f_c_string(str(1:6), flag)
- ! CHECK: Test 5: 4
- print '(A,I0)', 'Test 5: ', len(result)
- if (len(result) /= 4) error stop 'Test 5 failed'
-
- ! Test 6: Empty (all blanks)
- result = f_c_string(' ')
- ! CHECK: Test 6: 1
- print '(A,I0)', 'Test 6: ', len(result)
- if (result /= c_null_char) error stop 'Test 6 failed'
-
- ! Test 7: Internal blanks preserved
- result = f_c_string('a b c ')
- ! CHECK: Test 7: 6
- print '(A,I0)', 'Test 7: ', len(result)
- if (result /= 'a b c' // c_null_char) error stop 'Test 7 failed'
-
- ! CHECK: PASS
- print *, 'PASS'
-
-end program test_f_c_string
diff --git a/flang/test/Semantics/f_c_string.f90 b/flang/test/Semantics/f_c_string.f90
new file mode 100644
index 0000000000000..172cbc49c7c8c
--- /dev/null
+++ b/flang/test/Semantics/f_c_string.f90
@@ -0,0 +1,39 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Test semantic checking of F_C_STRING from ISO_C_BINDING
+
+program test
+ use iso_c_binding
+ implicit none
+
+ character(len=20) :: str
+ character(len=:), allocatable :: result
+ logical :: flag
+ integer :: n
+
+ ! Valid usages
+ result = f_c_string('hello')
+ result = f_c_string(str)
+ result = f_c_string(str, .true.)
+ result = f_c_string(str, .false.)
+ result = f_c_string(str, flag)
+ result = f_c_string(string=str)
+ result = f_c_string(string=str, asis=.true.)
+ result = f_c_string(asis=.false., string=str)
+
+ ! Invalid: missing required argument
+ !ERROR: missing mandatory 'string=' argument
+ result = f_c_string()
+
+ ! Invalid: too many arguments
+ !ERROR: No intrinsic or generic 'f_c_string' matches the actual arguments
+ result = f_c_string(str, .true., .false.)
+
+ ! Invalid: non-character first argument
+ !ERROR: No intrinsic or generic 'f_c_string' matches the actual arguments
+ result = f_c_string(n)
+
+ ! Invalid: non-logical second argument
+ !ERROR: No intrinsic or generic 'f_c_string' matches the actual arguments
+ result = f_c_string(str, n)
+
+end program
>From ae2e60e5b47a004bc0e04a630743835d59e0757b Mon Sep 17 00:00:00 2001
From: Caroline Newcombe <caroline.newcombe at hpe.com>
Date: Tue, 6 Jan 2026 13:20:44 -0600
Subject: [PATCH 3/9] Update text for semantics checking
---
flang/test/Semantics/f_c_string.f90 | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/flang/test/Semantics/f_c_string.f90 b/flang/test/Semantics/f_c_string.f90
index 172cbc49c7c8c..eb72c138a92e7 100644
--- a/flang/test/Semantics/f_c_string.f90
+++ b/flang/test/Semantics/f_c_string.f90
@@ -21,19 +21,19 @@ program test
result = f_c_string(asis=.false., string=str)
! Invalid: missing required argument
- !ERROR: missing mandatory 'string=' argument
+ !ERROR: Dummy argument 'string=' (#1) is not OPTIONAL and is not associated with an actual argument in this procedure reference
result = f_c_string()
! Invalid: too many arguments
- !ERROR: No intrinsic or generic 'f_c_string' matches the actual arguments
+ !ERROR: Too many actual arguments (3) passed to procedure that expects only 2
result = f_c_string(str, .true., .false.)
! Invalid: non-character first argument
- !ERROR: No intrinsic or generic 'f_c_string' matches the actual arguments
+ !ERROR: Actual argument type 'INTEGER(4)' is not compatible with dummy argument type 'CHARACTER(KIND=1,LEN=*)'
result = f_c_string(n)
! Invalid: non-logical second argument
- !ERROR: No intrinsic or generic 'f_c_string' matches the actual arguments
+ !ERROR: Actual argument type 'INTEGER(4)' is not compatible with dummy argument type 'LOGICAL(4)'
result = f_c_string(str, n)
end program
>From 3dec8418a7c4898bb2fd2bdd2cfb5b5e49704a35 Mon Sep 17 00:00:00 2001
From: Caroline Newcombe <caroline.newcombe at hpe.com>
Date: Wed, 7 Jan 2026 14:20:02 -0600
Subject: [PATCH 4/9] Move f_c_string implementation to submodule
---
flang-rt/lib/runtime/CMakeLists.txt | 1 +
flang/module/iso_c_binding.f90 | 23 ++++++++-------------
flang/module/iso_c_binding_impl.f90 | 32 +++++++++++++++++++++++++++++
flang/test/Semantics/f_c_string.f90 | 8 ++++----
4 files changed, 46 insertions(+), 18 deletions(-)
create mode 100644 flang/module/iso_c_binding_impl.f90
diff --git a/flang-rt/lib/runtime/CMakeLists.txt b/flang-rt/lib/runtime/CMakeLists.txt
index d18f24e6c786a..87187063bc551 100644
--- a/flang-rt/lib/runtime/CMakeLists.txt
+++ b/flang-rt/lib/runtime/CMakeLists.txt
@@ -76,6 +76,7 @@ set(supported_sources
set(host_sources
${FLANG_SOURCE_DIR}/module/iso_fortran_env_impl.f90
${FLANG_SOURCE_DIR}/module/iso_c_binding.f90
+ ${FLANG_SOURCE_DIR}/module/iso_c_binding_impl.f90
command.cpp
complex-powi.cpp
complex-reduction.c
diff --git a/flang/module/iso_c_binding.f90 b/flang/module/iso_c_binding.f90
index 34e7b6280f54d..9de9ff491a732 100644
--- a/flang/module/iso_c_binding.f90
+++ b/flang/module/iso_c_binding.f90
@@ -137,6 +137,15 @@ module iso_c_binding
c_uint_least64_t = c_uint64_t, &
c_uint_least128_t = c_uint128_t
+ ! Implemented in submodule
+ interface f_c_string
+ module function f_c_string(string, asis) result(res)
+ character(kind=c_char, len=*), intent(in) :: string
+ logical, optional, intent(in) :: asis
+ character(kind=c_char, len=:), allocatable :: res
+ end function f_c_string
+ end interface
+
contains
subroutine c_f_procpointer(cptr, fptr)
@@ -145,18 +154,4 @@ subroutine c_f_procpointer(cptr, fptr)
! TODO: implement
end subroutine c_f_procpointer
- ! F_C_STRING - Convert Fortran string to C null-terminated string
- ! Fortran 2023 standard intrinsic
- pure function f_c_string(string, asis) result(res)
- character(kind=c_char, len=*), intent(in) :: string
- logical, optional, intent(in) :: asis
- character(kind=c_char, len=:), allocatable :: res
-
- if (present(asis) .and. asis) then
- res = string // c_null_char
- else
- res = trim(string) // c_null_char
- end if
- end function f_c_string
-
end module iso_c_binding
diff --git a/flang/module/iso_c_binding_impl.f90 b/flang/module/iso_c_binding_impl.f90
new file mode 100644
index 0000000000000..cff3b856027f2
--- /dev/null
+++ b/flang/module/iso_c_binding_impl.f90
@@ -0,0 +1,32 @@
+!===-- module/iso_c_binding.f90 --------------------------------------------===!
+!
+! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+! See https://llvm.org/LICENSE.txt for license information.
+! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+!
+!===------------------------------------------------------------------------===!
+
+submodule (iso_c_binding) iso_c_binding_impl
+ implicit none
+
+contains
+
+ ! F_C_STRING - Convert Fortran string to C null-terminated string
+ ! Fortran 2023 standard intrinsic
+ module function f_c_string(string, asis) result(res)
+ character(kind=c_char, len=*), intent(in) :: string
+ logical, optional, intent(in) :: asis
+ character(kind=c_char, len=:), allocatable :: res
+ logical :: use_asis
+
+ use_asis = .false.
+ if (present(asis)) use_asis = asis
+
+ if (use_asis) then
+ res = string // c_null_char
+ else
+ res = trim(string) // c_null_char
+ end if
+ end function f_c_string
+
+end submodule iso_c_binding_impl
\ No newline at end of file
diff --git a/flang/test/Semantics/f_c_string.f90 b/flang/test/Semantics/f_c_string.f90
index eb72c138a92e7..100322f24a0f9 100644
--- a/flang/test/Semantics/f_c_string.f90
+++ b/flang/test/Semantics/f_c_string.f90
@@ -21,19 +21,19 @@ program test
result = f_c_string(asis=.false., string=str)
! Invalid: missing required argument
- !ERROR: Dummy argument 'string=' (#1) is not OPTIONAL and is not associated with an actual argument in this procedure reference
+ !ERROR: No specific function of generic 'f_c_string' matches the actual arguments
result = f_c_string()
! Invalid: too many arguments
- !ERROR: Too many actual arguments (3) passed to procedure that expects only 2
+ !ERROR: No specific function of generic 'f_c_string' matches the actual arguments
result = f_c_string(str, .true., .false.)
! Invalid: non-character first argument
- !ERROR: Actual argument type 'INTEGER(4)' is not compatible with dummy argument type 'CHARACTER(KIND=1,LEN=*)'
+ !ERROR: No specific function of generic 'f_c_string' matches the actual arguments
result = f_c_string(n)
! Invalid: non-logical second argument
- !ERROR: Actual argument type 'INTEGER(4)' is not compatible with dummy argument type 'LOGICAL(4)'
+ !ERROR: No specific function of generic 'f_c_string' matches the actual arguments
result = f_c_string(str, n)
end program
>From eb7a7bf3c9a60cad9c8671987149cb2c975d5f9d Mon Sep 17 00:00:00 2001
From: Caroline Newcombe <caroline.newcombe at hpe.com>
Date: Fri, 9 Jan 2026 14:12:17 -0600
Subject: [PATCH 5/9] [flang] Implement f_c_string as built-in intrinsic
Replaces the Fortran submodule implementation with a compiler
built-in intrinsic following review feedback.
The implementation includes:
- Runtime function in flang-rt/lib/runtime/character.cpp
- Semantic analysis in __builtin_f_c_string table
- FIR lowering
- Testing (semantic, lowering, and unit tests)
---
flang-rt/lib/runtime/CMakeLists.txt | 2 -
flang-rt/lib/runtime/character.cpp | 24 +++++
flang-rt/unittests/Runtime/CharacterTest.cpp | 102 ++++++++++++++++++
.../flang/Optimizer/Builder/IntrinsicCall.h | 2 +
.../Optimizer/Builder/Runtime/Character.h | 14 +++
flang/include/flang/Runtime/character.h | 4 +
flang/lib/Evaluate/intrinsics.cpp | 5 +
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 40 +++++++
.../Optimizer/Builder/Runtime/Character.cpp | 17 +++
flang/module/__fortran_builtins.f90 | 3 +
flang/module/iso_c_binding.f90 | 10 +-
flang/module/iso_c_binding_impl.f90 | 32 ------
flang/test/Lower/Intrinsics/f_c_string.f90 | 56 ++++++++++
flang/test/Semantics/f_c_string.f90 | 36 ++++---
14 files changed, 291 insertions(+), 56 deletions(-)
delete mode 100644 flang/module/iso_c_binding_impl.f90
create mode 100644 flang/test/Lower/Intrinsics/f_c_string.f90
diff --git a/flang-rt/lib/runtime/CMakeLists.txt b/flang-rt/lib/runtime/CMakeLists.txt
index 87187063bc551..7fa8c2cb95417 100644
--- a/flang-rt/lib/runtime/CMakeLists.txt
+++ b/flang-rt/lib/runtime/CMakeLists.txt
@@ -75,8 +75,6 @@ set(supported_sources
# List of source not used for GPU offloading.
set(host_sources
${FLANG_SOURCE_DIR}/module/iso_fortran_env_impl.f90
- ${FLANG_SOURCE_DIR}/module/iso_c_binding.f90
- ${FLANG_SOURCE_DIR}/module/iso_c_binding_impl.f90
command.cpp
complex-powi.cpp
complex-reduction.c
diff --git a/flang-rt/lib/runtime/character.cpp b/flang-rt/lib/runtime/character.cpp
index c9ac55736d427..969da34fb2e2c 100644
--- a/flang-rt/lib/runtime/character.cpp
+++ b/flang-rt/lib/runtime/character.cpp
@@ -843,6 +843,30 @@ void RTDEF(Repeat)(Descriptor &result, const Descriptor &string,
}
}
+// F_C_STRING - Appends null terminator to create C-compatible string
+// If asis is false, trailing blanks are trimmed first
+void RTDEF(FCString)(Descriptor &result, const Descriptor &string,
+ const Descriptor *asis, const char *sourceFile, int sourceLine) {
+ Terminator terminator{sourceFile, sourceLine};
+ RUNTIME_CHECK(terminator, string.raw().type == CFI_type_char);
+
+ std::size_t chars{string.ElementBytes()};
+ if (!asis || !IsLogicalElementTrue(*asis, nullptr)) {
+ chars = LenTrim(string.OffsetElement<const char>(), chars);
+ }
+ std::size_t resultBytes{chars + 1};
+
+ result.Establish(string.type(), resultBytes, nullptr, 0, nullptr,
+ CFI_attribute_allocatable);
+ RUNTIME_CHECK(terminator, result.Allocate(kNoAsyncObject) == CFI_SUCCESS);
+
+ if (chars > 0) {
+ std::memcpy(result.OffsetElement(), string.OffsetElement(), chars);
+ }
+
+ result.OffsetElement<char>()[chars] = '\0';
+}
+
void RTDEF(Trim)(Descriptor &result, const Descriptor &string,
const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
diff --git a/flang-rt/unittests/Runtime/CharacterTest.cpp b/flang-rt/unittests/Runtime/CharacterTest.cpp
index 2c7af27b9da77..ef388a43af123 100644
--- a/flang-rt/unittests/Runtime/CharacterTest.cpp
+++ b/flang-rt/unittests/Runtime/CharacterTest.cpp
@@ -430,3 +430,105 @@ TYPED_TEST(RepeatTests, Repeat) {
RunRepeatTest<TypeParam>(t.ncopies, t.input, t.output);
}
}
+
+// Test F_C_STRING()
+TEST(CharacterTests, FCString) {
+ // Test 1: Default behavior (trim trailing blanks)
+ {
+ static char buffer[11]; // "abc " = 10 chars
+ std::memset(buffer, ' ', 10);
+ std::memcpy(buffer, "abc", 3);
+
+ StaticDescriptor<0> inputStaticDescriptor;
+ Descriptor &input{inputStaticDescriptor.descriptor()};
+ input.Establish(TypeCode{CFI_type_char}, /*elemLen=*/10, buffer, 0, nullptr,
+ CFI_attribute_pointer);
+
+ OwningPtr<Descriptor> result{Descriptor::Create(TypeCode{CFI_type_char}, 1,
+ nullptr, 0, nullptr, CFI_attribute_allocatable)};
+
+ RTNAME(FCString)(*result, input, /*asis=*/nullptr);
+
+ EXPECT_EQ(result->ElementBytes(), std::size_t(4)); // "abc\0" = 4 bytes
+ const char *data = result->OffsetElement<char>();
+ EXPECT_EQ(std::string(data, 4), std::string("abc\0", 4));
+
+ result->Destroy();
+ }
+
+ // Test 2: Keep trailing blanks (asis=true)
+ {
+ static char buffer[11];
+ std::memset(buffer, ' ', 10);
+ std::memcpy(buffer, "abc", 3);
+
+ StaticDescriptor<0> inputStaticDescriptor;
+ Descriptor &input{inputStaticDescriptor.descriptor()};
+ input.Establish(TypeCode{CFI_type_char}, /*elemLen=*/10, buffer, 0, nullptr,
+ CFI_attribute_pointer);
+
+ // Create asis descriptor (true)
+ static std::uint32_t asisValue = 1; // true
+ StaticDescriptor<0> asisStaticDescriptor;
+ Descriptor &asis{asisStaticDescriptor.descriptor()};
+ asis.Establish(TypeCategory::Logical, 4, &asisValue, 0, nullptr,
+ CFI_attribute_pointer);
+
+ OwningPtr<Descriptor> result{Descriptor::Create(TypeCode{CFI_type_char}, 1,
+ nullptr, 0, nullptr, CFI_attribute_allocatable)};
+
+ RTNAME(FCString)(*result, input, &asis);
+
+ EXPECT_EQ(
+ result->ElementBytes(), std::size_t(11)); // "abc \0" = 11 bytes
+ const char *data = result->OffsetElement<char>();
+ EXPECT_EQ(data[3], ' '); // Verify space preserved
+ EXPECT_EQ(data[10], '\0'); // Verify null terminator
+
+ result->Destroy();
+ }
+
+ // Test 3: All blanks, trimmed
+ {
+ static char buffer[11];
+ std::memset(buffer, ' ', 10);
+
+ StaticDescriptor<0> inputStaticDescriptor;
+ Descriptor &input{inputStaticDescriptor.descriptor()};
+ input.Establish(TypeCode{CFI_type_char}, /*elemLen=*/10, buffer, 0, nullptr,
+ CFI_attribute_pointer);
+
+ OwningPtr<Descriptor> result{Descriptor::Create(TypeCode{CFI_type_char}, 1,
+ nullptr, 0, nullptr, CFI_attribute_allocatable)};
+
+ RTNAME(FCString)(*result, input, /*asis=*/nullptr);
+
+ EXPECT_EQ(result->ElementBytes(), std::size_t(1)); // Just "\0"
+ const char *data = result->OffsetElement<char>();
+ EXPECT_EQ(data[0], '\0');
+
+ result->Destroy();
+ }
+
+ // Test 4: No trailing blanks
+ {
+ static char buffer[11];
+ std::memcpy(buffer, "hello", 5);
+
+ StaticDescriptor<0> inputStaticDescriptor;
+ Descriptor &input{inputStaticDescriptor.descriptor()};
+ input.Establish(TypeCode{CFI_type_char}, /*elemLen=*/5, buffer, 0, nullptr,
+ CFI_attribute_pointer);
+
+ OwningPtr<Descriptor> result{Descriptor::Create(TypeCode{CFI_type_char}, 1,
+ nullptr, 0, nullptr, CFI_attribute_allocatable)};
+
+ RTNAME(FCString)(*result, input, /*asis=*/nullptr);
+
+ EXPECT_EQ(result->ElementBytes(), std::size_t(6)); // "hello\0"
+ const char *data = result->OffsetElement<char>();
+ EXPECT_EQ(std::string(data, 6), std::string("hello\0", 6));
+
+ result->Destroy();
+ }
+}
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index b248106b51101..f99a79fc70c30 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -253,6 +253,8 @@ struct IntrinsicLibrary {
llvm::ArrayRef<fir::ExtendedValue>);
template <Extremum, ExtremumBehavior>
mlir::Value genExtremum(mlir::Type, llvm::ArrayRef<mlir::Value>);
+ fir::ExtendedValue genFCString(mlir::Type,
+ llvm::ArrayRef<fir::ExtendedValue>);
mlir::Value genFloor(mlir::Type, llvm::ArrayRef<mlir::Value>);
void genFlush(llvm::ArrayRef<fir::ExtendedValue>);
mlir::Value genFraction(mlir::Type resultType,
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Character.h b/flang/include/flang/Optimizer/Builder/Runtime/Character.h
index 261ac348a4024..b7181e33d6887 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Character.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Character.h
@@ -57,6 +57,20 @@ mlir::Value genCharCompare(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value lhsLen, mlir::Value rhsBuff,
mlir::Value rhsLen);
+/// Generate call to F_C_STRING intrinsic runtime routine
+/// This appends a null character to a Fortran character string to create
+/// a C-compatible null-terminated string.
+///
+/// \p resultBox must be an unallocated allocatable used for the temporary
+/// result. \p stringBox must be a fir.box describing the F_C_STRING string
+/// argument. \p asis must be a boxed logical value (fir.box<i1>) or an
+/// AbsentOp: if true, trailing blanks are kept; if false or absent (default),
+/// trailing blanks are trimmed before appending the null.
+/// The runtime will always allocate the resultBox.
+void genFCString(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::Value resultBox, mlir::Value stringBox,
+ mlir::Value asis);
+
/// Generate call to INDEX runtime.
/// This calls the simple runtime entry points based on the KIND of the string.
/// No descriptors are used.
diff --git a/flang/include/flang/Runtime/character.h b/flang/include/flang/Runtime/character.h
index dd47686fe858f..d028e1fe7c47f 100644
--- a/flang/include/flang/Runtime/character.h
+++ b/flang/include/flang/Runtime/character.h
@@ -93,6 +93,10 @@ void RTDECL(Repeat)(Descriptor &result, const Descriptor &string,
void RTDECL(Trim)(Descriptor &result, const Descriptor &string,
const char *sourceFile = nullptr, int sourceLine = 0);
+void RTDECL(FCString)(Descriptor &result, const Descriptor &string,
+ const Descriptor *asis /*can be null*/, const char *sourceFile = nullptr,
+ int sourceLine = 0);
+
void RTDECL(CharacterMax)(Descriptor &accumulator, const Descriptor &x,
const char *sourceFile = nullptr, int sourceLine = 0);
void RTDECL(CharacterMin)(Descriptor &accumulator, const Descriptor &x,
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 72ac9e2f68758..91fbef581c8a3 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -132,6 +132,7 @@ static constexpr TypePattern DefaultChar{CharType, KindCode::defaultCharKind};
static constexpr TypePattern DefaultLogical{
LogicalType, KindCode::defaultLogicalKind};
static constexpr TypePattern BOZ{IntType, KindCode::typeless};
+static constexpr TypePattern CChar{CharType, KindCode::exactKind, 1};
static constexpr TypePattern EventType{DerivedType, KindCode::eventType};
static constexpr TypePattern IeeeFlagType{DerivedType, KindCode::ieeeFlagType};
static constexpr TypePattern IeeeRoundType{
@@ -517,6 +518,10 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
Optionality::required, common::Intent::In,
{ArgFlag::canBeMoldNull}}},
DefaultLogical, Rank::scalar, IntrinsicClass::inquiryFunction},
+ {"__builtin_f_c_string",
+ {{"string", CChar, Rank::scalar},
+ {"asis", AnyLogical, Rank::scalar, Optionality::optional}},
+ CChar, Rank::scalar, IntrinsicClass::transformationalFunction},
{"failed_images", {OptionalTEAM, SizeDefaultKIND}, KINDInt, Rank::vector,
IntrinsicClass::transformationalFunction},
{"findloc",
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 75a74eeb18417..8598fe83d325d 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -298,6 +298,10 @@ static constexpr IntrinsicHandler handlers[]{
&I::genExtendsTypeOf,
{{{"a", asBox}, {"mold", asBox}}},
/*isElemental=*/false},
+ {"f_c_string",
+ &I::genFCString,
+ {{{"string", asAddr}, {"asis", asValue, handleDynamicOptional}}},
+ /*isElemental=*/false},
{"findloc",
&I::genFindloc,
{{{"array", asBox},
@@ -3881,6 +3885,42 @@ IntrinsicLibrary::genExtendsTypeOf(mlir::Type resultType,
fir::getBase(args[1])));
}
+// F_C_STRING
+fir::ExtendedValue
+IntrinsicLibrary::genFCString(mlir::Type resultType,
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ assert(args.size() >= 1 && args.size() <= 2);
+
+ mlir::Value string = builder.createBox(loc, args[0]);
+
+ // Handle optional ASIS argument - box it for runtime call
+ auto makeRefThenEmbox = [&](mlir::Value b) {
+ fir::LogicalType logTy = fir::LogicalType::get(
+ builder.getContext(), builder.getKindMap().defaultLogicalKind());
+ mlir::Value temp = builder.createTemporary(loc, logTy);
+ mlir::Value castb = builder.createConvert(loc, logTy, b);
+ fir::StoreOp::create(builder, loc, castb, temp);
+ return builder.createBox(loc, temp);
+ };
+ mlir::Value asisBoxed =
+ isStaticallyAbsent(args, 1)
+ ? fir::AbsentOp::create(builder, loc,
+ fir::BoxType::get(builder.getI1Type()))
+ : makeRefThenEmbox(fir::getBase(args[1]));
+
+ // Create mutable fir.box to be passed to the runtime for the result.
+ fir::MutableBoxValue resultMutableBox =
+ fir::factory::createTempMutableBox(builder, loc, resultType);
+ mlir::Value resultIrBox =
+ fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
+
+ fir::runtime::genFCString(builder, loc, resultIrBox, string, asisBoxed);
+
+ // Read result from mutable fir.box and add it to the list of temps to be
+ // finalized by the StatementContext.
+ return readAndAddCleanUp(resultMutableBox, resultType, "F_C_STRING");
+}
+
// FINDLOC
fir::ExtendedValue
IntrinsicLibrary::genFindloc(mlir::Type resultType,
diff --git a/flang/lib/Optimizer/Builder/Runtime/Character.cpp b/flang/lib/Optimizer/Builder/Runtime/Character.cpp
index 2f1772f602ac4..386f4a667809d 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Character.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Character.cpp
@@ -147,6 +147,23 @@ mlir::Value fir::runtime::genCharCompare(fir::FirOpBuilder &builder,
rhsBuffer, fir::getLen(rhs));
}
+void fir::runtime::genFCString(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::Value resultBox, mlir::Value stringBox,
+ mlir::Value asis) {
+ mlir::func::FuncOp func =
+ fir::runtime::getRuntimeFunc<mkRTKey(FCString)>(loc, builder);
+ mlir::FunctionType funcTy = func.getFunctionType();
+ mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
+ mlir::Value sourceLine =
+ fir::factory::locationToLineNo(builder, loc, funcTy.getInput(4));
+ llvm::SmallVector<mlir::Value> args = {
+ builder.createConvert(loc, funcTy.getInput(0), resultBox),
+ builder.createConvert(loc, funcTy.getInput(1), stringBox),
+ builder.createConvert(loc, funcTy.getInput(2), asis), sourceFile,
+ sourceLine};
+ builder.create<fir::CallOp>(loc, func, args);
+}
+
mlir::Value fir::runtime::genIndex(fir::FirOpBuilder &builder,
mlir::Location loc, int kind,
mlir::Value stringBase,
diff --git a/flang/module/__fortran_builtins.f90 b/flang/module/__fortran_builtins.f90
index a9b60508785db..3f313f8ffbe8d 100644
--- a/flang/module/__fortran_builtins.f90
+++ b/flang/module/__fortran_builtins.f90
@@ -28,6 +28,9 @@
intrinsic :: __builtin_c_f_pointer
public :: __builtin_c_f_pointer
+ intrinsic :: __builtin_f_c_string
+ public :: __builtin_f_c_string
+
intrinsic :: __builtin_show_descriptor
public :: __builtin_show_descriptor
diff --git a/flang/module/iso_c_binding.f90 b/flang/module/iso_c_binding.f90
index 9de9ff491a732..12b67c5caea21 100644
--- a/flang/module/iso_c_binding.f90
+++ b/flang/module/iso_c_binding.f90
@@ -20,6 +20,7 @@ module iso_c_binding
c_null_ptr => __builtin_c_null_ptr, &
c_ptr => __builtin_c_ptr, &
c_sizeof => sizeof, &
+ f_c_string => __builtin_f_c_string, &
operator(==), operator(/=)
implicit none
@@ -137,15 +138,6 @@ module iso_c_binding
c_uint_least64_t = c_uint64_t, &
c_uint_least128_t = c_uint128_t
- ! Implemented in submodule
- interface f_c_string
- module function f_c_string(string, asis) result(res)
- character(kind=c_char, len=*), intent(in) :: string
- logical, optional, intent(in) :: asis
- character(kind=c_char, len=:), allocatable :: res
- end function f_c_string
- end interface
-
contains
subroutine c_f_procpointer(cptr, fptr)
diff --git a/flang/module/iso_c_binding_impl.f90 b/flang/module/iso_c_binding_impl.f90
deleted file mode 100644
index cff3b856027f2..0000000000000
--- a/flang/module/iso_c_binding_impl.f90
+++ /dev/null
@@ -1,32 +0,0 @@
-!===-- module/iso_c_binding.f90 --------------------------------------------===!
-!
-! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
-! See https://llvm.org/LICENSE.txt for license information.
-! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
-!
-!===------------------------------------------------------------------------===!
-
-submodule (iso_c_binding) iso_c_binding_impl
- implicit none
-
-contains
-
- ! F_C_STRING - Convert Fortran string to C null-terminated string
- ! Fortran 2023 standard intrinsic
- module function f_c_string(string, asis) result(res)
- character(kind=c_char, len=*), intent(in) :: string
- logical, optional, intent(in) :: asis
- character(kind=c_char, len=:), allocatable :: res
- logical :: use_asis
-
- use_asis = .false.
- if (present(asis)) use_asis = asis
-
- if (use_asis) then
- res = string // c_null_char
- else
- res = trim(string) // c_null_char
- end if
- end function f_c_string
-
-end submodule iso_c_binding_impl
\ No newline at end of file
diff --git a/flang/test/Lower/Intrinsics/f_c_string.f90 b/flang/test/Lower/Intrinsics/f_c_string.f90
new file mode 100644
index 0000000000000..d204245675c29
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/f_c_string.f90
@@ -0,0 +1,56 @@
+! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s
+! RUN: %flang_fc1 -emit-fir -flang-deprecated-no-hlfir %s -o - | FileCheck %s
+
+! Test lowering of F_C_STRING intrinsic from ISO_C_BINDING
+
+! CHECK-LABEL: func @_QPtest_default(
+! CHECK-SAME: %[[arg0:.*]]: !fir.boxchar<1>{{.*}}) {
+subroutine test_default(str)
+ use iso_c_binding
+ character(*) :: str
+ character(:), allocatable :: result
+
+ ! CHECK: %[[tmpBox:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>>
+ ! CHECK: %[[strBox:.*]] = fir.embox %{{.*}} typeparams %{{.*}} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+ ! CHECK: %[[resBoxNone:.*]] = fir.convert %[[tmpBox]] : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>) -> !fir.ref<!fir.box<none>>
+ ! CHECK: %[[strBoxNone:.*]] = fir.convert %[[strBox]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+ ! CHECK: %{{.*}} = fir.convert %{{.*}} : (!fir.box<i1>) -> !fir.box<none>
+ ! CHECK: fir.call @_FortranAFCString(%[[resBoxNone]], %[[strBoxNone]], %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.box<none>, !fir.ref<!fir.char<1,{{.*}}>>, i32) -> ()
+ result = f_c_string(str)
+
+ ! CHECK: fir.freemem
+end subroutine
+
+! CHECK-LABEL: func @_QPtest_with_asis(
+! CHECK-SAME: %[[arg0:.*]]: !fir.boxchar<1>{{.*}}, %[[arg1:.*]]: !fir.ref<!fir.logical<4>>{{.*}}) {
+subroutine test_with_asis(str, keep_blanks)
+ use iso_c_binding
+ character(*) :: str
+ logical :: keep_blanks
+ character(:), allocatable :: result
+
+ ! CHECK: %[[tmpBox:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>>
+ ! CHECK: %[[strBox:.*]] = fir.embox %{{.*}} typeparams %{{.*}} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+ ! CHECK: %[[asisBox:.*]] = fir.embox %{{.*}} : (!fir.ref<!fir.logical<4>>) -> !fir.box<!fir.logical<4>>
+ ! CHECK: %[[resBoxNone:.*]] = fir.convert %[[tmpBox]] : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>) -> !fir.ref<!fir.box<none>>
+ ! CHECK: %[[strBoxNone:.*]] = fir.convert %[[strBox]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+ ! CHECK: %[[asisBoxNone:.*]] = fir.convert %[[asisBox]] : (!fir.box<!fir.logical<4>>) -> !fir.box<none>
+ ! CHECK: fir.call @_FortranAFCString(%[[resBoxNone]], %[[strBoxNone]], %[[asisBoxNone]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.box<none>, !fir.ref<!fir.char<1,{{.*}}>>, i32) -> ()
+ result = f_c_string(str, keep_blanks)
+
+ ! CHECK: fir.freemem
+end subroutine
+
+! CHECK-LABEL: func @_QPtest_literal_asis(
+subroutine test_literal_asis()
+ use iso_c_binding
+ character(:), allocatable :: result
+
+ ! CHECK: %[[asisTemp:.*]] = fir.alloca !fir.logical<4>
+ ! CHECK: %[[trueVal:.*]] = arith.constant true
+ ! CHECK: %[[trueLogical:.*]] = fir.convert %[[trueVal]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[trueLogical]] to %[[asisTemp]] : !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[asisBox:.*]] = fir.embox %[[asisTemp]] : (!fir.ref<!fir.logical<4>>) -> !fir.box<!fir.logical<4>>
+ ! CHECK: fir.call @_FortranAFCString(%{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.box<none>, !fir.ref<!fir.char<1,{{.*}}>>, i32) -> ()
+ result = f_c_string('hello', .true.)
+end subroutine
diff --git a/flang/test/Semantics/f_c_string.f90 b/flang/test/Semantics/f_c_string.f90
index 100322f24a0f9..cfba259590ffb 100644
--- a/flang/test/Semantics/f_c_string.f90
+++ b/flang/test/Semantics/f_c_string.f90
@@ -4,12 +4,14 @@
program test
use iso_c_binding
implicit none
-
+
character(len=20) :: str
character(len=:), allocatable :: result
logical :: flag
integer :: n
-
+ real :: x
+ character(len=20), dimension(2) :: str_array
+
! Valid usages
result = f_c_string('hello')
result = f_c_string(str)
@@ -19,21 +21,29 @@ program test
result = f_c_string(string=str)
result = f_c_string(string=str, asis=.true.)
result = f_c_string(asis=.false., string=str)
-
+
! Invalid: missing required argument
- !ERROR: No specific function of generic 'f_c_string' matches the actual arguments
+ !ERROR: missing mandatory 'string=' argument
result = f_c_string()
-
- ! Invalid: too many arguments
- !ERROR: No specific function of generic 'f_c_string' matches the actual arguments
- result = f_c_string(str, .true., .false.)
-
+
! Invalid: non-character first argument
- !ERROR: No specific function of generic 'f_c_string' matches the actual arguments
+ !ERROR: Actual argument for 'string=' has bad type 'INTEGER(4)'
result = f_c_string(n)
-
+
+ ! Invalid: non-character first argument (real)
+ !ERROR: Actual argument for 'string=' has bad type 'REAL(4)'
+ result = f_c_string(x)
+
! Invalid: non-logical second argument
- !ERROR: No specific function of generic 'f_c_string' matches the actual arguments
+ !ERROR: Actual argument for 'asis=' has bad type 'INTEGER(4)'
result = f_c_string(str, n)
-
+
+ ! Invalid: too many arguments
+ !ERROR: too many actual arguments for intrinsic '__builtin_f_c_string'
+ result = f_c_string(str, .true., .false.)
+
+ ! Invalid: array argument (must be scalar)
+ !ERROR: 'string=' argument has unacceptable rank 1
+ result = f_c_string(str_array)
+
end program
>From b37107258d26c4074c06153ddec2e1a6520f82c2 Mon Sep 17 00:00:00 2001
From: Caroline Newcombe <caroline.newcombe at hpe.com>
Date: Fri, 16 Jan 2026 14:00:50 -0600
Subject: [PATCH 6/9] [flang] Fix genFCString to use standard FIR call pattern
---
.../Optimizer/Builder/Runtime/Character.cpp | 20 ++++++++-----------
flang/test/Lower/Intrinsics/f_c_string.f90 | 10 ++++++----
2 files changed, 14 insertions(+), 16 deletions(-)
diff --git a/flang/lib/Optimizer/Builder/Runtime/Character.cpp b/flang/lib/Optimizer/Builder/Runtime/Character.cpp
index 386f4a667809d..e297125880f7a 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Character.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Character.cpp
@@ -150,18 +150,14 @@ mlir::Value fir::runtime::genCharCompare(fir::FirOpBuilder &builder,
void fir::runtime::genFCString(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value resultBox, mlir::Value stringBox,
mlir::Value asis) {
- mlir::func::FuncOp func =
- fir::runtime::getRuntimeFunc<mkRTKey(FCString)>(loc, builder);
- mlir::FunctionType funcTy = func.getFunctionType();
- mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
- mlir::Value sourceLine =
- fir::factory::locationToLineNo(builder, loc, funcTy.getInput(4));
- llvm::SmallVector<mlir::Value> args = {
- builder.createConvert(loc, funcTy.getInput(0), resultBox),
- builder.createConvert(loc, funcTy.getInput(1), stringBox),
- builder.createConvert(loc, funcTy.getInput(2), asis), sourceFile,
- sourceLine};
- builder.create<fir::CallOp>(loc, func, args);
+ auto func = fir::runtime::getRuntimeFunc<mkRTKey(FCString)>(loc, builder);
+ auto fTy = func.getFunctionType();
+ auto sourceFile = fir::factory::locationToFilename(builder, loc);
+ auto sourceLine =
+ fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));
+ auto args = fir::runtime::createArguments(
+ builder, loc, fTy, resultBox, stringBox, asis, sourceFile, sourceLine);
+ fir::CallOp::create(builder, loc, func, args);
}
mlir::Value fir::runtime::genIndex(fir::FirOpBuilder &builder,
diff --git a/flang/test/Lower/Intrinsics/f_c_string.f90 b/flang/test/Lower/Intrinsics/f_c_string.f90
index d204245675c29..21418a6235e0c 100644
--- a/flang/test/Lower/Intrinsics/f_c_string.f90
+++ b/flang/test/Lower/Intrinsics/f_c_string.f90
@@ -15,7 +15,8 @@ subroutine test_default(str)
! CHECK: %[[resBoxNone:.*]] = fir.convert %[[tmpBox]] : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>) -> !fir.ref<!fir.box<none>>
! CHECK: %[[strBoxNone:.*]] = fir.convert %[[strBox]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
! CHECK: %{{.*}} = fir.convert %{{.*}} : (!fir.box<i1>) -> !fir.box<none>
- ! CHECK: fir.call @_FortranAFCString(%[[resBoxNone]], %[[strBoxNone]], %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.box<none>, !fir.ref<!fir.char<1,{{.*}}>>, i32) -> ()
+ ! CHECK: %{{.*}} = fir.convert %{{.*}} : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+ ! CHECK: fir.call @_FortranAFCString(%[[resBoxNone]], %[[strBoxNone]], %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> ()
result = f_c_string(str)
! CHECK: fir.freemem
@@ -35,7 +36,8 @@ subroutine test_with_asis(str, keep_blanks)
! CHECK: %[[resBoxNone:.*]] = fir.convert %[[tmpBox]] : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>) -> !fir.ref<!fir.box<none>>
! CHECK: %[[strBoxNone:.*]] = fir.convert %[[strBox]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
! CHECK: %[[asisBoxNone:.*]] = fir.convert %[[asisBox]] : (!fir.box<!fir.logical<4>>) -> !fir.box<none>
- ! CHECK: fir.call @_FortranAFCString(%[[resBoxNone]], %[[strBoxNone]], %[[asisBoxNone]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.box<none>, !fir.ref<!fir.char<1,{{.*}}>>, i32) -> ()
+ ! CHECK: %{{.*}} = fir.convert %{{.*}} : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+ ! CHECK: fir.call @_FortranAFCString(%[[resBoxNone]], %[[strBoxNone]], %[[asisBoxNone]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> ()
result = f_c_string(str, keep_blanks)
! CHECK: fir.freemem
@@ -50,7 +52,7 @@ subroutine test_literal_asis()
! CHECK: %[[trueVal:.*]] = arith.constant true
! CHECK: %[[trueLogical:.*]] = fir.convert %[[trueVal]] : (i1) -> !fir.logical<4>
! CHECK: fir.store %[[trueLogical]] to %[[asisTemp]] : !fir.ref<!fir.logical<4>>
- ! CHECK: %[[asisBox:.*]] = fir.embox %[[asisTemp]] : (!fir.ref<!fir.logical<4>>) -> !fir.box<!fir.logical<4>>
- ! CHECK: fir.call @_FortranAFCString(%{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.box<none>, !fir.ref<!fir.char<1,{{.*}}>>, i32) -> ()
+ ! CHECK: %{{.*}} = fir.convert %{{.*}} : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+ ! CHECK: fir.call @_FortranAFCString(%{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> ()
result = f_c_string('hello', .true.)
end subroutine
>From e0e318d4a328ad7b9f51e1aa88799026fdf2756e Mon Sep 17 00:00:00 2001
From: Caroline Newcombe <caroline.newcombe at hpe.com>
Date: Thu, 22 Jan 2026 09:10:19 -0600
Subject: [PATCH 7/9] [flang] Use defaultCharKind and -emit-hlfir in F_C_STRING
(#176973)
- Update lowering tests to use -emit-hlfir flag
- Replace hardcoded C_CHAR kind with KindCode::defaultCharKind
- These changes made based on feedback provided on PR #176973 that also
applies to f_c_string
---
flang/lib/Evaluate/intrinsics.cpp | 2 +-
flang/test/Lower/Intrinsics/f_c_string.f90 | 4 ++--
2 files changed, 3 insertions(+), 3 deletions(-)
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 91fbef581c8a3..b04a8e73e3559 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -132,7 +132,7 @@ static constexpr TypePattern DefaultChar{CharType, KindCode::defaultCharKind};
static constexpr TypePattern DefaultLogical{
LogicalType, KindCode::defaultLogicalKind};
static constexpr TypePattern BOZ{IntType, KindCode::typeless};
-static constexpr TypePattern CChar{CharType, KindCode::exactKind, 1};
+static constexpr TypePattern CChar{CharType, KindCode::defaultCharKind};
static constexpr TypePattern EventType{DerivedType, KindCode::eventType};
static constexpr TypePattern IeeeFlagType{DerivedType, KindCode::ieeeFlagType};
static constexpr TypePattern IeeeRoundType{
diff --git a/flang/test/Lower/Intrinsics/f_c_string.f90 b/flang/test/Lower/Intrinsics/f_c_string.f90
index 21418a6235e0c..32b8703c98004 100644
--- a/flang/test/Lower/Intrinsics/f_c_string.f90
+++ b/flang/test/Lower/Intrinsics/f_c_string.f90
@@ -1,5 +1,5 @@
-! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s
-! RUN: %flang_fc1 -emit-fir -flang-deprecated-no-hlfir %s -o - | FileCheck %s
+! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
+! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
! Test lowering of F_C_STRING intrinsic from ISO_C_BINDING
>From bb59228bdcca03e3862d537defdd671b7aeac03a Mon Sep 17 00:00:00 2001
From: Caroline Newcombe <caroline.newcombe at hpe.com>
Date: Fri, 30 Jan 2026 11:45:00 -0600
Subject: [PATCH 8/9] [flang] Use OffsetElement offset parameter in FCString
---
flang-rt/lib/runtime/character.cpp | 6 +-----
1 file changed, 1 insertion(+), 5 deletions(-)
diff --git a/flang-rt/lib/runtime/character.cpp b/flang-rt/lib/runtime/character.cpp
index 969da34fb2e2c..13d8bd6739c4b 100644
--- a/flang-rt/lib/runtime/character.cpp
+++ b/flang-rt/lib/runtime/character.cpp
@@ -849,22 +849,18 @@ void RTDEF(FCString)(Descriptor &result, const Descriptor &string,
const Descriptor *asis, const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
RUNTIME_CHECK(terminator, string.raw().type == CFI_type_char);
-
std::size_t chars{string.ElementBytes()};
if (!asis || !IsLogicalElementTrue(*asis, nullptr)) {
chars = LenTrim(string.OffsetElement<const char>(), chars);
}
std::size_t resultBytes{chars + 1};
-
result.Establish(string.type(), resultBytes, nullptr, 0, nullptr,
CFI_attribute_allocatable);
RUNTIME_CHECK(terminator, result.Allocate(kNoAsyncObject) == CFI_SUCCESS);
-
if (chars > 0) {
std::memcpy(result.OffsetElement(), string.OffsetElement(), chars);
}
-
- result.OffsetElement<char>()[chars] = '\0';
+ *result.OffsetElement<char>(chars) = '\0';
}
void RTDEF(Trim)(Descriptor &result, const Descriptor &string,
>From 9189add82f9a0bdc3da9ccc7d311e437e389b415 Mon Sep 17 00:00:00 2001
From: Caroline Newcombe <caroline.newcombe at hpe.com>
Date: Mon, 9 Feb 2026 10:42:56 -0600
Subject: [PATCH 9/9] [flang] Change F_C_STRING asis parameter from Descriptor
to bool
---
flang-rt/lib/runtime/character.cpp | 6 +++---
flang-rt/unittests/Runtime/CharacterTest.cpp | 15 ++++----------
flang/include/flang/Runtime/character.h | 3 +--
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 20 +++++--------------
flang/test/Lower/Intrinsics/f_c_string.f90 | 14 ++++---------
5 files changed, 17 insertions(+), 41 deletions(-)
diff --git a/flang-rt/lib/runtime/character.cpp b/flang-rt/lib/runtime/character.cpp
index 13d8bd6739c4b..04c9055f84498 100644
--- a/flang-rt/lib/runtime/character.cpp
+++ b/flang-rt/lib/runtime/character.cpp
@@ -845,12 +845,12 @@ void RTDEF(Repeat)(Descriptor &result, const Descriptor &string,
// F_C_STRING - Appends null terminator to create C-compatible string
// If asis is false, trailing blanks are trimmed first
-void RTDEF(FCString)(Descriptor &result, const Descriptor &string,
- const Descriptor *asis, const char *sourceFile, int sourceLine) {
+void RTDEF(FCString)(Descriptor &result, const Descriptor &string, bool asis,
+ const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
RUNTIME_CHECK(terminator, string.raw().type == CFI_type_char);
std::size_t chars{string.ElementBytes()};
- if (!asis || !IsLogicalElementTrue(*asis, nullptr)) {
+ if (!asis) {
chars = LenTrim(string.OffsetElement<const char>(), chars);
}
std::size_t resultBytes{chars + 1};
diff --git a/flang-rt/unittests/Runtime/CharacterTest.cpp b/flang-rt/unittests/Runtime/CharacterTest.cpp
index ef388a43af123..5d8bcd2354c4c 100644
--- a/flang-rt/unittests/Runtime/CharacterTest.cpp
+++ b/flang-rt/unittests/Runtime/CharacterTest.cpp
@@ -447,7 +447,7 @@ TEST(CharacterTests, FCString) {
OwningPtr<Descriptor> result{Descriptor::Create(TypeCode{CFI_type_char}, 1,
nullptr, 0, nullptr, CFI_attribute_allocatable)};
- RTNAME(FCString)(*result, input, /*asis=*/nullptr);
+ RTNAME(FCString)(*result, input, /*asis=*/false);
EXPECT_EQ(result->ElementBytes(), std::size_t(4)); // "abc\0" = 4 bytes
const char *data = result->OffsetElement<char>();
@@ -467,17 +467,10 @@ TEST(CharacterTests, FCString) {
input.Establish(TypeCode{CFI_type_char}, /*elemLen=*/10, buffer, 0, nullptr,
CFI_attribute_pointer);
- // Create asis descriptor (true)
- static std::uint32_t asisValue = 1; // true
- StaticDescriptor<0> asisStaticDescriptor;
- Descriptor &asis{asisStaticDescriptor.descriptor()};
- asis.Establish(TypeCategory::Logical, 4, &asisValue, 0, nullptr,
- CFI_attribute_pointer);
-
OwningPtr<Descriptor> result{Descriptor::Create(TypeCode{CFI_type_char}, 1,
nullptr, 0, nullptr, CFI_attribute_allocatable)};
- RTNAME(FCString)(*result, input, &asis);
+ RTNAME(FCString)(*result, input, /*asis=*/true);
EXPECT_EQ(
result->ElementBytes(), std::size_t(11)); // "abc \0" = 11 bytes
@@ -501,7 +494,7 @@ TEST(CharacterTests, FCString) {
OwningPtr<Descriptor> result{Descriptor::Create(TypeCode{CFI_type_char}, 1,
nullptr, 0, nullptr, CFI_attribute_allocatable)};
- RTNAME(FCString)(*result, input, /*asis=*/nullptr);
+ RTNAME(FCString)(*result, input, /*asis=*/false);
EXPECT_EQ(result->ElementBytes(), std::size_t(1)); // Just "\0"
const char *data = result->OffsetElement<char>();
@@ -523,7 +516,7 @@ TEST(CharacterTests, FCString) {
OwningPtr<Descriptor> result{Descriptor::Create(TypeCode{CFI_type_char}, 1,
nullptr, 0, nullptr, CFI_attribute_allocatable)};
- RTNAME(FCString)(*result, input, /*asis=*/nullptr);
+ RTNAME(FCString)(*result, input, /*asis=*/false);
EXPECT_EQ(result->ElementBytes(), std::size_t(6)); // "hello\0"
const char *data = result->OffsetElement<char>();
diff --git a/flang/include/flang/Runtime/character.h b/flang/include/flang/Runtime/character.h
index d028e1fe7c47f..36a66fc50e717 100644
--- a/flang/include/flang/Runtime/character.h
+++ b/flang/include/flang/Runtime/character.h
@@ -94,8 +94,7 @@ void RTDECL(Trim)(Descriptor &result, const Descriptor &string,
const char *sourceFile = nullptr, int sourceLine = 0);
void RTDECL(FCString)(Descriptor &result, const Descriptor &string,
- const Descriptor *asis /*can be null*/, const char *sourceFile = nullptr,
- int sourceLine = 0);
+ bool asis = false, const char *sourceFile = nullptr, int sourceLine = 0);
void RTDECL(CharacterMax)(Descriptor &accumulator, const Descriptor &x,
const char *sourceFile = nullptr, int sourceLine = 0);
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 8598fe83d325d..43802da48a0e6 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -3893,20 +3893,10 @@ IntrinsicLibrary::genFCString(mlir::Type resultType,
mlir::Value string = builder.createBox(loc, args[0]);
- // Handle optional ASIS argument - box it for runtime call
- auto makeRefThenEmbox = [&](mlir::Value b) {
- fir::LogicalType logTy = fir::LogicalType::get(
- builder.getContext(), builder.getKindMap().defaultLogicalKind());
- mlir::Value temp = builder.createTemporary(loc, logTy);
- mlir::Value castb = builder.createConvert(loc, logTy, b);
- fir::StoreOp::create(builder, loc, castb, temp);
- return builder.createBox(loc, temp);
- };
- mlir::Value asisBoxed =
- isStaticallyAbsent(args, 1)
- ? fir::AbsentOp::create(builder, loc,
- fir::BoxType::get(builder.getI1Type()))
- : makeRefThenEmbox(fir::getBase(args[1]));
+ // Handle optional ASIS argument
+ mlir::Value asis = isStaticallyAbsent(args, 1)
+ ? builder.createBool(loc, false)
+ : fir::getBase(args[1]);
// Create mutable fir.box to be passed to the runtime for the result.
fir::MutableBoxValue resultMutableBox =
@@ -3914,7 +3904,7 @@ IntrinsicLibrary::genFCString(mlir::Type resultType,
mlir::Value resultIrBox =
fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
- fir::runtime::genFCString(builder, loc, resultIrBox, string, asisBoxed);
+ fir::runtime::genFCString(builder, loc, resultIrBox, string, asis);
// Read result from mutable fir.box and add it to the list of temps to be
// finalized by the StatementContext.
diff --git a/flang/test/Lower/Intrinsics/f_c_string.f90 b/flang/test/Lower/Intrinsics/f_c_string.f90
index 32b8703c98004..f6fabab897365 100644
--- a/flang/test/Lower/Intrinsics/f_c_string.f90
+++ b/flang/test/Lower/Intrinsics/f_c_string.f90
@@ -14,9 +14,8 @@ subroutine test_default(str)
! CHECK: %[[strBox:.*]] = fir.embox %{{.*}} typeparams %{{.*}} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
! CHECK: %[[resBoxNone:.*]] = fir.convert %[[tmpBox]] : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>) -> !fir.ref<!fir.box<none>>
! CHECK: %[[strBoxNone:.*]] = fir.convert %[[strBox]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
- ! CHECK: %{{.*}} = fir.convert %{{.*}} : (!fir.box<i1>) -> !fir.box<none>
! CHECK: %{{.*}} = fir.convert %{{.*}} : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
- ! CHECK: fir.call @_FortranAFCString(%[[resBoxNone]], %[[strBoxNone]], %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> ()
+ ! CHECK: fir.call @_FortranAFCString(%[[resBoxNone]], %[[strBoxNone]], %{{(false|.*)}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.ref<i8>, i32) -> ()
result = f_c_string(str)
! CHECK: fir.freemem
@@ -32,12 +31,11 @@ subroutine test_with_asis(str, keep_blanks)
! CHECK: %[[tmpBox:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>>
! CHECK: %[[strBox:.*]] = fir.embox %{{.*}} typeparams %{{.*}} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
- ! CHECK: %[[asisBox:.*]] = fir.embox %{{.*}} : (!fir.ref<!fir.logical<4>>) -> !fir.box<!fir.logical<4>>
! CHECK: %[[resBoxNone:.*]] = fir.convert %[[tmpBox]] : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>) -> !fir.ref<!fir.box<none>>
! CHECK: %[[strBoxNone:.*]] = fir.convert %[[strBox]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
- ! CHECK: %[[asisBoxNone:.*]] = fir.convert %[[asisBox]] : (!fir.box<!fir.logical<4>>) -> !fir.box<none>
+ ! CHECK: %[[asisBool:.*]] = fir.convert %{{.*}} : (!fir.logical<4>) -> i1
! CHECK: %{{.*}} = fir.convert %{{.*}} : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
- ! CHECK: fir.call @_FortranAFCString(%[[resBoxNone]], %[[strBoxNone]], %[[asisBoxNone]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> ()
+ ! CHECK: fir.call @_FortranAFCString(%[[resBoxNone]], %[[strBoxNone]], %[[asisBool]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.ref<i8>, i32) -> ()
result = f_c_string(str, keep_blanks)
! CHECK: fir.freemem
@@ -48,11 +46,7 @@ subroutine test_literal_asis()
use iso_c_binding
character(:), allocatable :: result
- ! CHECK: %[[asisTemp:.*]] = fir.alloca !fir.logical<4>
- ! CHECK: %[[trueVal:.*]] = arith.constant true
- ! CHECK: %[[trueLogical:.*]] = fir.convert %[[trueVal]] : (i1) -> !fir.logical<4>
- ! CHECK: fir.store %[[trueLogical]] to %[[asisTemp]] : !fir.ref<!fir.logical<4>>
! CHECK: %{{.*}} = fir.convert %{{.*}} : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
- ! CHECK: fir.call @_FortranAFCString(%{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> ()
+ ! CHECK: fir.call @_FortranAFCString(%{{.*}}, %{{.*}}, %{{(true|.*)}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.ref<i8>, i32) -> ()
result = f_c_string('hello', .true.)
end subroutine
More information about the llvm-commits
mailing list