From 8f38fd1416a0924cc644eb38e73c04b94ae82f94 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Fri, 19 Jun 2026 09:28:53 +0100 Subject: [PATCH] feat(stdlib): add CodePointToString UTF-8 encoder to strutils Adds CodePointToString(CP: Integer): string, the inverse of CodePointAt / CodePointFromByteIndex. It encodes a Unicode codepoint (0..U+10FFFF) as its 1..4 byte UTF-8 sequence, providing the codepoint-aware replacement for the Char(n) cast used in other Pascal dialects. Chr(n) only writes a single raw byte, which is invalid for codepoints above 127; CodePointToString emits the correct multi-byte form. Out-of-range values yield an empty string. E2E tests cover single-byte ASCII, the two-byte 0xC2 0xB1 encoding of U+00B1, a round-trip across all four UTF-8 length classes, and out-of-range handling. --- .../src/test/pascal/cp.test.e2e.strutils.pas | 86 +++++++++++++++++++ stdlib/src/main/pascal/strutils.pas | 29 +++++++ 2 files changed, 115 insertions(+) diff --git a/compiler/src/test/pascal/cp.test.e2e.strutils.pas b/compiler/src/test/pascal/cp.test.e2e.strutils.pas index 0eb3bc0..8b2dcbd 100644 --- a/compiler/src/test/pascal/cp.test.e2e.strutils.pas +++ b/compiler/src/test/pascal/cp.test.e2e.strutils.pas @@ -116,6 +116,10 @@ type procedure TestRun_CodePointPos_Found; procedure TestRun_CodePointFromByteIndex; procedure TestRun_CodePointByteIndex_Roundtrip; + procedure TestRun_CodePointToString_ASCII; + procedure TestRun_CodePointToString_TwoByteBytes; + procedure TestRun_CodePointToString_Roundtrip; + procedure TestRun_CodePointToString_OutOfRange; end; implementation @@ -1040,6 +1044,55 @@ const end. '''; + { ASCII codepoint 'A' (65) must encode to a single byte. } + SrcCodePointToStringASCII = ''' + program P; + uses StrUtils; + var S: string; + begin + S := CodePointToString(65); + WriteLn(Length(S)); + WriteLn(OrdAt(S, 0)) + end. + '''; + + { Codepoint U+00B1 (177, '±') must encode to the two UTF-8 bytes + 0xC2 0xB1 = 194, 177. } + SrcCodePointToStringTwoByteBytes = ''' + program P; + uses StrUtils; + var S: string; + begin + S := CodePointToString(177); + WriteLn(Length(S)); + WriteLn(OrdAt(S, 0)); + WriteLn(OrdAt(S, 1)) + end. + '''; + + { CodePointToString is the inverse of CodePointFromByteIndex across a + representative codepoint from each UTF-8 length class. } + SrcCodePointToStringRoundtrip = ''' + program P; + uses StrUtils; + begin + WriteLn(CodePointFromByteIndex(CodePointToString(65), 0)); + WriteLn(CodePointFromByteIndex(CodePointToString(177), 0)); + WriteLn(CodePointFromByteIndex(CodePointToString(8364), 0)); + WriteLn(CodePointFromByteIndex(CodePointToString(128512), 0)) + end. + '''; + + { Out-of-range codepoints yield an empty string. } + SrcCodePointToStringOutOfRange = ''' + program P; + uses StrUtils; + begin + WriteLn(Length(CodePointToString(-1))); + WriteLn(Length(CodePointToString(1114112))) + end. + '''; + procedure TE2EStrUtilsTests.TestRun_CodePointSize; var Output: string; RCode: Integer; begin @@ -1104,6 +1157,39 @@ begin AssertEquals('byte indices', '0' + Chr(10) + '1' + Chr(10) + '3', Trim(Output)); end; +procedure TE2EStrUtilsTests.TestRun_CodePointToString_ASCII; +var Output: string; RCode: Integer; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertTrue('compile+run', CompileAndRunWithRTL(SrcCodePointToStringASCII, Output, RCode)); + AssertEquals('len+byte', '1' + Chr(10) + '65', Trim(Output)); +end; + +procedure TE2EStrUtilsTests.TestRun_CodePointToString_TwoByteBytes; +var Output: string; RCode: Integer; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertTrue('compile+run', CompileAndRunWithRTL(SrcCodePointToStringTwoByteBytes, Output, RCode)); + AssertEquals('len+bytes', '2' + Chr(10) + '194' + Chr(10) + '177', Trim(Output)); +end; + +procedure TE2EStrUtilsTests.TestRun_CodePointToString_Roundtrip; +var Output: string; RCode: Integer; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertTrue('compile+run', CompileAndRunWithRTL(SrcCodePointToStringRoundtrip, Output, RCode)); + AssertEquals('codepoints', + '65' + Chr(10) + '177' + Chr(10) + '8364' + Chr(10) + '128512', Trim(Output)); +end; + +procedure TE2EStrUtilsTests.TestRun_CodePointToString_OutOfRange; +var Output: string; RCode: Integer; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertTrue('compile+run', CompileAndRunWithRTL(SrcCodePointToStringOutOfRange, Output, RCode)); + AssertEquals('empty', '0' + Chr(10) + '0', Trim(Output)); +end; + initialization RegisterTest(TE2EStrUtilsTests); diff --git a/stdlib/src/main/pascal/strutils.pas b/stdlib/src/main/pascal/strutils.pas index 05dfb18..73bb6ed 100644 --- a/stdlib/src/main/pascal/strutils.pas +++ b/stdlib/src/main/pascal/strutils.pas @@ -174,6 +174,15 @@ function CodePointByteIndex(const S: string; CPIndex: Integer): Integer; performed; the caller must ensure ByteIndex is within range. } function CodePointFromByteIndex(const S: string; ByteIndex: Integer): Integer; +{ Encodes a single Unicode codepoint (0..U+10FFFF) as its UTF-8 byte + sequence and returns it as a 1..4 byte string. This is the inverse of + CodePointAt / CodePointFromByteIndex. It is the codepoint-aware + replacement for the Char(n) cast found in other Pascal dialects: Chr(n) + only writes a single raw byte, which is invalid for codepoints above 127, + whereas CodePointToString emits the correct multi-byte form. Out-of-range + values (negative or above U+10FFFF) yield an empty string. } +function CodePointToString(CP: Integer): string; + { ------------------------------------------------------------------ } { TStringBuilder — efficient incremental string construction } { ------------------------------------------------------------------ } @@ -898,4 +907,24 @@ begin Result := Count; end; +function CodePointToString(CP: Integer): string; +begin + if (CP < 0) or (CP > $10FFFF) then + Result := '' + else if CP < $80 then + Result := Chr(CP) + else if CP < $800 then + Result := Chr($C0 or (CP shr 6)) + + Chr($80 or (CP and $3F)) + else if CP < $10000 then + Result := Chr($E0 or (CP shr 12)) + + Chr($80 or ((CP shr 6) and $3F)) + + Chr($80 or (CP and $3F)) + else + Result := Chr($F0 or (CP shr 18)) + + Chr($80 or ((CP shr 12) and $3F)) + + Chr($80 or ((CP shr 6) and $3F)) + + Chr($80 or (CP and $3F)); +end; + end.