-- 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.
--
-------------------------------------------------------------------------------
-- Lingenic-Text — Normalization conformance test
--
-- Parses NormalizationTest.txt and verifies all 18 invariants per line:
--
-- NFC: c2 == toNFC(c1) == toNFC(c2) == toNFC(c3)
-- c4 == toNFC(c4) == toNFC(c5)
-- NFD: c3 == toNFD(c1) == toNFD(c2) == toNFD(c3)
-- c5 == toNFD(c4) == toNFD(c5)
-- NFKC: c4 == toNFKC(c1) == toNFKC(c2) == toNFKC(c3)
-- == toNFKC(c4) == toNFKC(c5)
-- NFKD: c5 == toNFKD(c1) == toNFKD(c2) == toNFKD(c3)
-- == toNFKD(c4) == toNFKD(c5)
-------------------------------------------------------------------------------
with Ada.Text_IO;
with Ada.Command_Line;
with Lingenic_Text.Normalization;
with Lingenic_Text.Normalization_Spec;
with Lingenic_Text.UTF8;
procedure Test_Normalization is
use Ada.Text_IO;
use Lingenic_Text;
use Lingenic_Text.Normalization;
use Lingenic_Text.Normalization_Spec;
Init_OK : Boolean;
Total : Natural := 0;
Passed : Natural := 0;
Failed : Natural := 0;
-- Maximum codepoints per column in the test file
Max_CPs : constant := 64;
type CP_Array is array (1 .. Max_CPs) of Codepoint;
-- 5 columns per test line: c1 .. c5
type Column_CPs is record
CPs : CP_Array := [others => 0];
Num_CPs : Natural := 0;
end record;
type Columns_Type is array (1 .. 5) of Column_CPs;
---------------------------------------------------------------------------
-- Parse a hex string to a codepoint value
---------------------------------------------------------------------------
function Hex_To_CP (S : String) return Natural is
Val : Natural := 0;
begin
for I in S'Range loop
Val := Val * 16;
case S (I) is
when '0' .. '9' =>
Val := Val + (Character'Pos (S (I)) - Character'Pos ('0'));
when 'A' .. 'F' =>
Val := Val + (Character'Pos (S (I)) - Character'Pos ('A') + 10);
when 'a' .. 'f' =>
Val := Val + (Character'Pos (S (I)) - Character'Pos ('a') + 10);
when others =>
return 0;
end case;
end loop;
return Val;
end Hex_To_CP;
---------------------------------------------------------------------------
-- Encode codepoints to UTF-8 byte array
---------------------------------------------------------------------------
Max_Bytes : constant := 512;
type UTF8_Buffer is record
Data : Byte_Array (1 .. Max_Bytes) := [others => 0];
Len : Natural := 0;
end record;
procedure Encode_CPs
(CPs : CP_Array;
Num_CPs : Natural;
Buf : out UTF8_Buffer)
is
Pos : Positive := 1;
Enc_Len : Positive;
begin
Buf := (Data => [others => 0], Len => 0);
for I in 1 .. Num_CPs loop
if Pos > Max_Bytes - 3 then
Put_Line ("ERROR: buffer overflow in Encode_CPs");
return;
end if;
if Is_Scalar_Value (CPs (I)) then
UTF8.Encode (CPs (I), Buf.Data, Pos, Enc_Len);
Pos := Pos + Enc_Len;
end if;
end loop;
Buf.Len := Pos - 1;
end Encode_CPs;
---------------------------------------------------------------------------
-- Compare two UTF-8 buffers
---------------------------------------------------------------------------
function Buffers_Equal (A, B : UTF8_Buffer) return Boolean is
begin
if A.Len /= B.Len then
return False;
end if;
for I in 1 .. A.Len loop
if A.Data (I) /= B.Data (I) then
return False;
end if;
end loop;
return True;
end Buffers_Equal;
---------------------------------------------------------------------------
-- Run normalization and return the result as a UTF8_Buffer
---------------------------------------------------------------------------
procedure Normalize_To_Buf
(Input : UTF8_Buffer;
Form : Normalization_Form;
Output : out UTF8_Buffer;
OK : out Boolean)
is
Out_Data : Byte_Array (1 .. Max_Bytes) := [others => 0];
Last : Natural;
Status : Norm_Status;
begin
Output := (Data => [others => 0], Len => 0);
OK := False;
if Input.Len = 0 then
Output.Len := 0;
OK := True;
return;
end if;
Normalization.Normalize
(Input.Data (1 .. Input.Len),
Form,
Out_Data,
Last,
Status);
if Status = Success then
Output.Len := Last;
Output.Data (1 .. Last) := Out_Data (1 .. Last);
OK := True;
else
Put_Line (" Normalization failed with status "
& Norm_Status'Image (Status));
end if;
end Normalize_To_Buf;
---------------------------------------------------------------------------
-- Parse one test line: "source; NFC; NFD; NFKC; NFKD; # comment"
-- Each column is space-separated hex codepoints.
---------------------------------------------------------------------------
procedure Parse_Line
(Line : String;
Cols : out Columns_Type;
Valid : out Boolean)
is
Pos : Natural := Line'First;
Col : Natural := 1;
In_Hex : Boolean := False;
Hex_Start : Natural := 0;
begin
Cols := [others => (CPs => [others => 0], Num_CPs => 0)];
Valid := False;
while Pos <= Line'Last and then Col <= 5 loop
case Line (Pos) is
when '#' =>
exit;
when ';' =>
-- End of current hex token if any
if In_Hex and then Hex_Start > 0 then
declare
CP_Val : constant Natural :=
Hex_To_CP (Line (Hex_Start .. Pos - 1));
begin
if CP_Val <= Max_Codepoint
and then Cols (Col).Num_CPs < Max_CPs
then
Cols (Col).Num_CPs := Cols (Col).Num_CPs + 1;
Cols (Col).CPs (Cols (Col).Num_CPs) := CP_Val;
end if;
end;
In_Hex := False;
end if;
Col := Col + 1;
when ' ' =>
-- End of a hex token
if In_Hex and then Hex_Start > 0 then
declare
CP_Val : constant Natural :=
Hex_To_CP (Line (Hex_Start .. Pos - 1));
begin
if CP_Val <= Max_Codepoint
and then Cols (Col).Num_CPs < Max_CPs
then
Cols (Col).Num_CPs := Cols (Col).Num_CPs + 1;
Cols (Col).CPs (Cols (Col).Num_CPs) := CP_Val;
end if;
end;
In_Hex := False;
end if;
when '0' .. '9' | 'A' .. 'F' | 'a' .. 'f' =>
if not In_Hex then
In_Hex := True;
Hex_Start := Pos;
end if;
when others =>
null;
end case;
Pos := Pos + 1;
end loop;
-- Must have parsed all 5 columns (Col went past 5)
if Col >= 6 and then Cols (1).Num_CPs > 0 then
Valid := True;
end if;
end Parse_Line;
---------------------------------------------------------------------------
-- Check one invariant
---------------------------------------------------------------------------
procedure Check_Invariant
(Label : String;
Input : UTF8_Buffer;
Form : Normalization_Form;
Expected : UTF8_Buffer;
Line_Num : Natural;
Pass : in out Boolean)
is
Result : UTF8_Buffer;
OK : Boolean;
begin
Normalize_To_Buf (Input, Form, Result, OK);
if not OK then
Put_Line ("FAIL line " & Natural'Image (Line_Num)
& ": " & Label & " — normalization failed");
Pass := False;
elsif not Buffers_Equal (Result, Expected) then
Put_Line ("FAIL line " & Natural'Image (Line_Num)
& ": " & Label & " — mismatch");
Pass := False;
end if;
end Check_Invariant;
---------------------------------------------------------------------------
-- Run one test line (18 invariants)
---------------------------------------------------------------------------
procedure Run_Test_Line
(Cols : Columns_Type;
Line_Num : Natural)
is
C : array (1 .. 5) of UTF8_Buffer;
Pass : Boolean := True;
begin
-- Encode all 5 columns to UTF-8
for I in 1 .. 5 loop
Encode_CPs (Cols (I).CPs, Cols (I).Num_CPs, C (I));
end loop;
-- NFC invariants:
-- c2 == toNFC(c1) == toNFC(c2) == toNFC(c3)
-- c4 == toNFC(c4) == toNFC(c5)
Check_Invariant ("toNFC(c1)==c2", C (1), NFC, C (2), Line_Num, Pass);
Check_Invariant ("toNFC(c2)==c2", C (2), NFC, C (2), Line_Num, Pass);
Check_Invariant ("toNFC(c3)==c2", C (3), NFC, C (2), Line_Num, Pass);
Check_Invariant ("toNFC(c4)==c4", C (4), NFC, C (4), Line_Num, Pass);
Check_Invariant ("toNFC(c5)==c4", C (5), NFC, C (4), Line_Num, Pass);
-- NFD invariants:
-- c3 == toNFD(c1) == toNFD(c2) == toNFD(c3)
-- c5 == toNFD(c4) == toNFD(c5)
Check_Invariant ("toNFD(c1)==c3", C (1), NFD, C (3), Line_Num, Pass);
Check_Invariant ("toNFD(c2)==c3", C (2), NFD, C (3), Line_Num, Pass);
Check_Invariant ("toNFD(c3)==c3", C (3), NFD, C (3), Line_Num, Pass);
Check_Invariant ("toNFD(c4)==c5", C (4), NFD, C (5), Line_Num, Pass);
Check_Invariant ("toNFD(c5)==c5", C (5), NFD, C (5), Line_Num, Pass);
-- NFKC invariants:
-- c4 == toNFKC(c1..c5)
Check_Invariant ("toNFKC(c1)==c4", C (1), NFKC, C (4), Line_Num, Pass);
Check_Invariant ("toNFKC(c2)==c4", C (2), NFKC, C (4), Line_Num, Pass);
Check_Invariant ("toNFKC(c3)==c4", C (3), NFKC, C (4), Line_Num, Pass);
Check_Invariant ("toNFKC(c4)==c4", C (4), NFKC, C (4), Line_Num, Pass);
Check_Invariant ("toNFKC(c5)==c4", C (5), NFKC, C (4), Line_Num, Pass);
-- NFKD invariants:
-- c5 == toNFKD(c1..c5)
Check_Invariant ("toNFKD(c1)==c5", C (1), NFKD, C (5), Line_Num, Pass);
Check_Invariant ("toNFKD(c2)==c5", C (2), NFKD, C (5), Line_Num, Pass);
Check_Invariant ("toNFKD(c3)==c5", C (3), NFKD, C (5), Line_Num, Pass);
Check_Invariant ("toNFKD(c4)==c5", C (4), NFKD, C (5), Line_Num, Pass);
Check_Invariant ("toNFKD(c5)==c5", C (5), NFKD, C (5), Line_Num, Pass);
Total := Total + 1;
if Pass then
Passed := Passed + 1;
else
Failed := Failed + 1;
end if;
end Run_Test_Line;
---------------------------------------------------------------------------
-- Main
---------------------------------------------------------------------------
File : File_Type;
Line_Num : Natural := 0;
begin
-- Initialize normalization module
declare
UCD_Dir : constant String :=
(if Ada.Command_Line.Argument_Count >= 1
then Ada.Command_Line.Argument (1)
else "ucd");
begin
Normalization.Initialize (UCD_Dir, Init_OK);
end;
if not Init_OK then
Put_Line ("FATAL: Normalization.Initialize failed");
Ada.Command_Line.Set_Exit_Status (1);
return;
end if;
Put_Line ("Normalization initialized.");
-- Open test file
declare
Test_File : constant String :=
(if Ada.Command_Line.Argument_Count >= 2
then Ada.Command_Line.Argument (2)
else "ucd/NormalizationTest.txt");
begin
Open (File, In_File, Test_File);
end;
while not End_Of_File (File) loop
declare
Line : constant String := Get_Line (File);
Cols : Columns_Type;
Valid : Boolean;
begin
Line_Num := Line_Num + 1;
-- Skip empty lines, comments, and @Part headers
if Line'Length = 0
or else Line (Line'First) = '#'
or else Line (Line'First) = '@'
then
null;
else
Parse_Line (Line, Cols, Valid);
if Valid then
Run_Test_Line (Cols, Line_Num);
end if;
end if;
end;
end loop;
Close (File);
Put_Line ("--------------------------------------------------");
Put_Line ("Total test cases:" & Natural'Image (Total));
Put_Line ("Passed: " & Natural'Image (Passed));
Put_Line ("Failed: " & Natural'Image (Failed));
Put_Line ("--------------------------------------------------");
if Failed > 0 then
Ada.Command_Line.Set_Exit_Status (1);
end if;
end Test_Normalization;