-- Copyright © 2026 Lingenic LLC. All rights reserved.
-- Licensed under the Lingenic Source-Available License v2.3.
-- Production use requires a separate license from Licensor.
-- See LICENSE.md and COPYRIGHT in the project root.
--
with Ada.Text_IO;
with Lingenic_Text.Collation;
with Lingenic_Text.Collation_Spec;
with Lingenic_Text.Normalization;
with Lingenic_Text.Normalization_Spec;
with Lingenic_Text.Properties;
with Lingenic_Text.UTF8;
procedure Debug_Collation is
use Ada.Text_IO;
use Lingenic_Text;
use Lingenic_Text.Collation;
use Lingenic_Text.Collation_Spec;
Init_OK : Boolean;
procedure Dump_Sort_Key (Label : String; Data : Byte_Array; Len : Natural) is
begin
Put (Label & " sort key (" & Natural'Image (Len) & " bytes): ");
for I in Data'First .. Data'First + Len - 1 loop
declare
V : constant Natural := Data (I);
H : constant String := "0123456789ABCDEF";
begin
Put (H (H'First + V / 16) & H (H'First + V mod 16) & " ");
end;
end loop;
New_Line;
end Dump_Sort_Key;
-- Encode a single codepoint to UTF-8
Max_Bytes : constant := 64;
type UTF8_Buffer is record
Data : Byte_Array (1 .. Max_Bytes) := [others => 0];
Len : Natural := 0;
end record;
procedure Encode_CP (CP : Codepoint; Buf : in out UTF8_Buffer) is
Pos : Positive;
Enc_Len : Positive;
begin
if Buf.Len >= Max_Bytes - 3 then return; end if;
Pos := Buf.Len + 1;
if Is_Scalar_Value (CP) then
UTF8.Encode (CP, Buf.Data, Pos, Enc_Len);
Buf.Len := Buf.Len + Enc_Len;
end if;
end Encode_CP;
procedure Test_Compare
(Label1 : String; CPs1 : Byte_Array; Len1 : Natural;
Label2 : String; CPs2 : Byte_Array; Len2 : Natural)
is
Key1 : Byte_Array (1 .. 4096) := [others => 0];
Key2 : Byte_Array (1 .. 4096) := [others => 0];
Last1, Last2 : Natural;
OK1, OK2 : Boolean;
Result : Comparison_Result;
CmpOK : Boolean;
begin
Sort_Key (CPs1 (1 .. Len1), Non_Ignorable, Key1, Last1, OK1);
Sort_Key (CPs2 (1 .. Len2), Non_Ignorable, Key2, Last2, OK2);
-- Also show Shifted key
declare
SK1 : Byte_Array (1 .. 4096) := [others => 0];
SK2 : Byte_Array (1 .. 4096) := [others => 0];
SL1, SL2 : Natural;
SOK1, SOK2 : Boolean;
begin
Sort_Key (CPs1 (1 .. Len1), Shifted, SK1, SL1, SOK1);
Sort_Key (CPs2 (1 .. Len2), Shifted, SK2, SL2, SOK2);
if SOK1 then
Dump_Sort_Key (Label1 & " [Shifted]", SK1, SL1);
end if;
if SOK2 then
Dump_Sort_Key (Label2 & " [Shifted]", SK2, SL2);
end if;
end;
Put_Line ("--- " & Label1 & " vs " & Label2 & " (Non_Ignorable) ---");
if OK1 then
Dump_Sort_Key (Label1, Key1, Last1);
else
Put_Line (Label1 & " Sort_Key FAILED");
end if;
if OK2 then
Dump_Sort_Key (Label2, Key2, Last2);
else
Put_Line (Label2 & " Sort_Key FAILED");
end if;
Compare (CPs1 (1 .. Len1), CPs2 (1 .. Len2),
Non_Ignorable, Result, CmpOK);
if CmpOK then
Put ("Compare result: ");
case Result is
when Less => Put_Line ("Less");
when Equal => Put_Line ("Equal");
when Greater => Put_Line ("Greater");
end case;
else
Put_Line ("Compare FAILED");
end if;
New_Line;
end Test_Compare;
Buf1, Buf2 : UTF8_Buffer;
begin
Properties.Initialize ("ucd", Init_OK);
if not Init_OK then Put_Line ("Properties init failed"); return; end if;
Normalization.Initialize ("ucd", Init_OK);
if not Init_OK then Put_Line ("Normalization init failed"); return; end if;
Collation.Initialize ("ucd", Init_OK);
if not Init_OK then Put_Line ("Collation init failed"); return; end if;
-- Test case: 0FB2 0591 0F71 0F80 0061 vs 0FB2 0591 0F81 0061
-- These should be Equal after NFD (both normalize to same form)
Buf1 := (Data => [others => 0], Len => 0);
Encode_CP (16#0FB2#, Buf1);
Encode_CP (16#0591#, Buf1);
Encode_CP (16#0F71#, Buf1);
Encode_CP (16#0F80#, Buf1);
Encode_CP (16#0061#, Buf1);
Buf2 := (Data => [others => 0], Len => 0);
Encode_CP (16#0FB2#, Buf2);
Encode_CP (16#0591#, Buf2);
Encode_CP (16#0F81#, Buf2);
Encode_CP (16#0061#, Buf2);
Test_Compare ("0FB2 0591 0F71 0F80 0061", Buf1.Data, Buf1.Len,
"0FB2 0591 0F81 0061", Buf2.Data, Buf2.Len);
-- Test NFD of full string 0FB2 0591 0F81 0061
Buf1 := (Data => [others => 0], Len => 0);
Encode_CP (16#0FB2#, Buf1);
Encode_CP (16#0591#, Buf1);
Encode_CP (16#0F81#, Buf1);
Encode_CP (16#0061#, Buf1);
declare
use type Normalization.Norm_Status;
NFD_Out : Byte_Array (1 .. 64) := [others => 0];
NFD_Last : Natural;
NFD_St : Normalization.Norm_Status;
Pos : Natural := 1;
CP_V : Codepoint;
Len : Positive;
Valid : Boolean;
begin
Normalization.Normalize
(Buf1.Data (1 .. Buf1.Len),
Lingenic_Text.Normalization_Spec.NFD,
NFD_Out, NFD_Last, NFD_St);
Put ("NFD(0FB2 0591 0F81 0061) = ");
if NFD_St = Normalization.Norm_Status'(Normalization.Success) then
while Pos <= NFD_Last loop
UTF8.Decode (NFD_Out (1 .. NFD_Last), Pos, CP_V, Len, Valid);
if Valid then
declare
V : constant Natural := CP_V;
H : constant String := "0123456789ABCDEF";
begin
Put (H (H'First + V / 4096 mod 16)
& H (H'First + V / 256 mod 16)
& H (H'First + V / 16 mod 16)
& H (H'First + V mod 16) & " ");
end;
Pos := Pos + Len;
else
Put ("(invalid) ");
Pos := Pos + 1;
end if;
end loop;
New_Line;
else
Put_Line ("FAILED");
end if;
end;
-- Also test the NFD result directly
Buf1 := (Data => [others => 0], Len => 0);
Encode_CP (16#0FB2#, Buf1);
Encode_CP (16#0F71#, Buf1);
Encode_CP (16#0F80#, Buf1);
Encode_CP (16#0591#, Buf1);
Encode_CP (16#0061#, Buf1);
Buf2 := (Data => [others => 0], Len => 0);
Encode_CP (16#0FB2#, Buf2);
Encode_CP (16#0F71#, Buf2);
Encode_CP (16#0F80#, Buf2);
Encode_CP (16#0591#, Buf2);
Encode_CP (16#0061#, Buf2);
Test_Compare ("NFD: 0FB2 0F71 0F80 0591 0061", Buf1.Data, Buf1.Len,
"NFD: 0FB2 0F71 0F80 0591 0061", Buf2.Data, Buf2.Len);
end Debug_Collation;