-- 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 — Word break conformance test
--
-- Parses WordBreakTest.txt and runs each test case through
-- Next_Word_Break. Compares break positions against
-- expected breaks from the test file.
-------------------------------------------------------------------------------
with Ada.Text_IO;
with Lingenic_Text.Properties;
with Lingenic_Text.Words;
with Lingenic_Text.UTF8;
procedure Test_Words is
use Ada.Text_IO;
use Lingenic_Text;
Success : Boolean;
Total : Natural := 0;
Passed : Natural := 0;
Failed : Natural := 0;
Max_CPs : constant := 64;
type CP_Array is array (1 .. Max_CPs) of Codepoint;
-- Parsed test case: codepoints and expected break positions.
-- Breaks(I) = True means there's a break BEFORE codepoint I.
-- Breaks(Num_CPs + 1) = True means break after last codepoint.
type Break_Array is array (1 .. Max_CPs + 1) of Boolean;
---------------------------------------------------------------------------
-- 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;
---------------------------------------------------------------------------
-- Parse a test line. Format:
-- ÷ 000D × 000A ÷ # comment
--
-- ÷ = break, × = no-break. Hex values are codepoints.
-- Returns the number of codepoints parsed, or 0 on failure.
---------------------------------------------------------------------------
procedure Parse_Line
(Line : String;
CPs : out CP_Array;
Breaks : out Break_Array;
Num_CPs : out Natural)
is
Pos : Natural := Line'First;
CP_Idx : Natural := 0;
In_Hex : Boolean := False;
Hex_Start : Natural := 0;
begin
CPs := [others => 0];
Breaks := [others => False];
Num_CPs := 0;
-- Skip to first non-space
while Pos <= Line'Last and then Line (Pos) = ' ' loop
Pos := Pos + 1;
end loop;
while Pos <= Line'Last loop
-- Check for comment marker
if Line (Pos) = '#' then
exit;
end if;
-- Check for ÷ (U+00F7, UTF-8: C3 B7)
if Pos + 1 <= Line'Last
and then Character'Pos (Line (Pos)) = 16#C3#
and then Character'Pos (Line (Pos + 1)) = 16#B7#
then
-- Break marker before next codepoint
Breaks (CP_Idx + 1) := True;
Pos := Pos + 2;
-- Check for × (U+00D7, UTF-8: C3 97)
elsif Pos + 1 <= Line'Last
and then Character'Pos (Line (Pos)) = 16#C3#
and then Character'Pos (Line (Pos + 1)) = 16#97#
then
-- No-break marker
Breaks (CP_Idx + 1) := False;
Pos := Pos + 2;
-- Hex digit
elsif Line (Pos) in '0' .. '9' | 'A' .. 'F' | 'a' .. 'f' then
if not In_Hex then
In_Hex := True;
Hex_Start := Pos;
end if;
Pos := Pos + 1;
-- Space (or other) — may end a hex token
else
if In_Hex then
CP_Idx := CP_Idx + 1;
if CP_Idx > Max_CPs then
Num_CPs := 0;
return;
end if;
CPs (CP_Idx) := Hex_To_CP (Line (Hex_Start .. Pos - 1));
In_Hex := False;
end if;
Pos := Pos + 1;
end if;
end loop;
-- Flush last hex token if any
if In_Hex and CP_Idx < Max_CPs then
CP_Idx := CP_Idx + 1;
CPs (CP_Idx) := Hex_To_CP (Line (Hex_Start .. Line'Last));
end if;
Num_CPs := CP_Idx;
end Parse_Line;
---------------------------------------------------------------------------
-- Encode codepoints to UTF-8 byte array
---------------------------------------------------------------------------
Max_Bytes : constant := Max_CPs * 4;
procedure Encode_CPs
(CPs : CP_Array;
Num_CPs : Natural;
Buf : out Byte_Array;
Buf_Len : out Natural)
is
Pos : Positive := 1;
Len : Positive;
begin
Buf := [others => 0];
Buf_Len := 0;
for I in 1 .. Num_CPs loop
if Is_Scalar_Value (CPs (I))
and then Pos + 3 <= Buf'Last
then
UTF8.Encode (CPs (I), Buf, Pos, Len);
Pos := Pos + Len;
end if;
end loop;
Buf_Len := Pos - 1;
end Encode_CPs;
---------------------------------------------------------------------------
-- Compute expected break byte positions from codepoint-level breaks
---------------------------------------------------------------------------
type Position_Array is array (1 .. Max_CPs + 1) of Natural;
procedure Compute_Expected_Breaks
(CPs : CP_Array;
Num_CPs : Natural;
Breaks : Break_Array;
Expected : out Position_Array;
Num_Expected : out Natural)
is
Byte_Pos : Positive := 1;
begin
Expected := [others => 0];
Num_Expected := 0;
for I in 1 .. Num_CPs loop
if Breaks (I) then
Num_Expected := Num_Expected + 1;
Expected (Num_Expected) := Byte_Pos;
end if;
-- Advance past this codepoint's UTF-8 bytes
if CPs (I) <= 16#7F# then
Byte_Pos := Byte_Pos + 1;
elsif CPs (I) <= 16#7FF# then
Byte_Pos := Byte_Pos + 2;
elsif CPs (I) <= 16#FFFF# then
Byte_Pos := Byte_Pos + 3;
else
Byte_Pos := Byte_Pos + 4;
end if;
end loop;
-- Break after last codepoint (always, WB2)
if Breaks (Num_CPs + 1) then
Num_Expected := Num_Expected + 1;
Expected (Num_Expected) := Byte_Pos;
end if;
end Compute_Expected_Breaks;
---------------------------------------------------------------------------
-- Run one test case
---------------------------------------------------------------------------
procedure Run_Test
(Line_Num : Positive;
Line : String)
is
CPs : CP_Array;
Brks : Break_Array;
Num_CPs : Natural;
Buf : Byte_Array (1 .. Max_Bytes) := [others => 0];
Buf_Len : Natural;
Expected : Position_Array;
Num_Exp : Natural;
Got : Position_Array;
Num_Got : Natural := 0;
Pos : Positive;
Next_Pos : Positive;
begin
Parse_Line (Line, CPs, Brks, Num_CPs);
if Num_CPs = 0 then
return;
end if;
Encode_CPs (CPs, Num_CPs, Buf, Buf_Len);
if Buf_Len = 0 then
return;
end if;
Compute_Expected_Breaks (CPs, Num_CPs, Brks, Expected, Num_Exp);
-- Run word break segmentation on the encoded text.
Num_Got := 1;
Got := [others => 0];
Got (1) := 1; -- WB1: break at start
Pos := 1;
while Pos <= Buf_Len loop
Words.Next_Word_Break (Buf (1 .. Buf_Len), Pos, Next_Pos);
Num_Got := Num_Got + 1;
if Num_Got <= Got'Last then
Got (Num_Got) := Next_Pos;
end if;
exit when Next_Pos > Buf_Len;
Pos := Next_Pos;
end loop;
Total := Total + 1;
-- Compare
if Num_Got /= Num_Exp then
Put_Line ("FAIL line" & Positive'Image (Line_Num) &
": expected" & Natural'Image (Num_Exp) &
" breaks, got" & Natural'Image (Num_Got));
Put (" Expected:");
for I in 1 .. Num_Exp loop
Put (Natural'Image (Expected (I)));
end loop;
New_Line;
Put (" Got: ");
for I in 1 .. Num_Got loop
Put (Natural'Image (Got (I)));
end loop;
New_Line;
Put_Line (" Line: " & Line (Line'First ..
Natural'Min (Line'Last, Line'First + 79)));
Failed := Failed + 1;
else
declare
Match : Boolean := True;
begin
for I in 1 .. Num_Exp loop
if Expected (I) /= Got (I) then
Match := False;
exit;
end if;
end loop;
if Match then
Passed := Passed + 1;
else
Put_Line ("FAIL line" & Positive'Image (Line_Num) &
": break positions differ");
Put (" Expected:");
for I in 1 .. Num_Exp loop
Put (Natural'Image (Expected (I)));
end loop;
New_Line;
Put (" Got: ");
for I in 1 .. Num_Got loop
Put (Natural'Image (Got (I)));
end loop;
New_Line;
Put_Line (" Line: " & Line (Line'First ..
Natural'Min (Line'Last, Line'First + 79)));
Failed := Failed + 1;
end if;
end;
end if;
end Run_Test;
F : File_Type;
begin
Put_Line ("=== Lingenic-Text Word Break Conformance Test ===");
Put_Line ("");
Properties.Initialize ("ucd", Success);
if not Success then
Put_Line ("FAIL: Initialize returned False");
return;
end if;
Put_Line ("Initialize: OK");
Put_Line ("");
-- Open and parse WordBreakTest.txt
Open (F, In_File, "ucd/WordBreakTest.txt");
declare
Line_Num : Positive := 1;
begin
while not End_Of_File (F) loop
declare
Line : constant String := Get_Line (F);
begin
-- Skip comment-only lines and blank lines
if Line'Length > 0 and then Line (Line'First) /= '#' then
Run_Test (Line_Num, Line);
end if;
Line_Num := Line_Num + 1;
end;
end loop;
end;
Close (F);
Put_Line ("=== Results ===");
Put_Line ("Total:" & Natural'Image (Total));
Put_Line ("Passed:" & Natural'Image (Passed));
Put_Line ("Failed:" & Natural'Image (Failed));
Put_Line ("");
if Failed = 0 then
Put_Line ("ALL TESTS PASSED");
else
Put_Line ("FAILURES DETECTED");
end if;
exception
when Ada.Text_IO.Name_Error =>
Put_Line ("ERROR: Cannot open ucd/WordBreakTest.txt");
end Test_Words;