-- 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 — Bidi conformance test
--
-- Runs all test cases from BidiCharacterTest.txt and verifies that
-- Resolve_Levels and Reorder produce the expected results.
--
-- Test format per line (5 fields separated by ';'):
-- Field 0: hex codepoints separated by space
-- Field 1: paragraph direction (0=LTR, 1=RTL, 2=auto)
-- Field 2: expected paragraph level
-- Field 3: expected levels ('x' = X9-removed)
-- Field 4: expected reorder indices
-------------------------------------------------------------------------------
with Ada.Text_IO;
with Ada.Command_Line;
with Lingenic_Text;
with Lingenic_Text.Properties;
with Lingenic_Text.Bidi;
with Lingenic_Text.Bidi_Spec;
with Lingenic_Text.UTF8;
procedure Test_Bidi is
use Lingenic_Text;
use Lingenic_Text.Bidi;
use Lingenic_Text.Bidi_Spec;
---------------------------------------------------------------------------
-- Hex parsing
---------------------------------------------------------------------------
function Is_Hex_Char (C : Character) return Boolean is
(C in '0' .. '9' or C in 'A' .. 'F' or C in 'a' .. 'f');
function Hex_Val (C : Character) return Natural is
begin
if C in '0' .. '9' then return Character'Pos (C) - Character'Pos ('0');
elsif C in 'A' .. 'F' then return Character'Pos (C) - Character'Pos ('A') + 10;
elsif C in 'a' .. 'f' then return Character'Pos (C) - Character'Pos ('a') + 10;
else return 0;
end if;
end Hex_Val;
---------------------------------------------------------------------------
-- UTF-8 encoding buffer
---------------------------------------------------------------------------
Max_UTF8 : constant := Max_Paragraph_CPs * 4;
type UTF8_Buffer is record
Data : Byte_Array (1 .. Max_UTF8) := [others => 0];
Len : Natural := 0;
end record;
procedure Encode_CP (Buf : in out UTF8_Buffer; CP : Codepoint) is
ELen : Positive := 1;
Start_Pos : Positive;
begin
-- Surrogates can't be encoded in UTF-8
if CP >= 16#D800# and then CP <= 16#DFFF# then
return;
end if;
-- Need at most 4 bytes
if Buf.Len + 4 <= Max_UTF8 then
Start_Pos := Buf.Len + 1;
UTF8.Encode (CP, Buf.Data, Start_Pos, ELen);
Buf.Len := Buf.Len + ELen;
end if;
end Encode_CP;
---------------------------------------------------------------------------
-- Test state
---------------------------------------------------------------------------
Total : Natural := 0;
Passed : Natural := 0;
Failed : Natural := 0;
Max_Failures_Shown : constant := 50;
---------------------------------------------------------------------------
-- Parse and run one test line
---------------------------------------------------------------------------
procedure Process_Line (Line : String; Line_Num : Positive) is
Pos : Positive := Line'First;
Last : constant Natural := Line'Last;
-- Skip to next semicolon and return position after it
procedure Skip_To_Semi is
begin
while Pos <= Last and then Line (Pos) /= ';' loop
Pos := Pos + 1;
end loop;
if Pos <= Last then Pos := Pos + 1; end if; -- skip ';'
end Skip_To_Semi;
-- Skip whitespace
procedure Skip_WS is
begin
while Pos <= Last and then (Line (Pos) = ' ' or Line (Pos) = ASCII.HT) loop
Pos := Pos + 1;
end loop;
end Skip_WS;
-- Parsed codepoints
CP_List : array (1 .. Max_Paragraph_CPs) of Codepoint := [others => 0];
Num_CPs_Parsed : Natural := 0;
-- Expected values
Exp_Dir : Natural := 2;
Exp_Para_Level : Natural := 0;
type Exp_Level_Array is array (1 .. Max_Paragraph_CPs) of Integer;
Exp_Levels : Exp_Level_Array := [others => -1]; -- -1 = 'x' (removed)
Num_Exp_Levels : Natural := 0;
type Exp_Order_Array is array (1 .. Max_Paragraph_CPs) of Integer;
Exp_Order : Exp_Order_Array := [others => -1];
Num_Exp_Order : Natural := 0;
-- UTF-8 encoding
Buf : UTF8_Buffer;
-- Results
Levels_Out : Level_Array;
Num_CPs_Out : Paragraph_Length;
Para_Level_Out : Embedding_Level;
Order_Out : Index_Array;
Dir : Paragraph_Direction;
Success : Boolean;
-- Comparison
Level_Match : Boolean := True;
Order_Match : Boolean := True;
Para_Level_Match : Boolean := True;
begin
-- Field 0: hex codepoints separated by space
Skip_WS;
while Pos <= Last and then Line (Pos) /= ';' loop
if Is_Hex_Char (Line (Pos)) then
declare
CP : Natural := 0;
begin
while Pos <= Last and then Is_Hex_Char (Line (Pos)) loop
CP := CP * 16 + Hex_Val (Line (Pos));
Pos := Pos + 1;
end loop;
if Num_CPs_Parsed < Max_Paragraph_CPs
and then CP <= Codepoint'Last
then
Num_CPs_Parsed := Num_CPs_Parsed + 1;
CP_List (Num_CPs_Parsed) := CP;
end if;
end;
else
Pos := Pos + 1; -- skip spaces
end if;
end loop;
Skip_To_Semi;
if Num_CPs_Parsed = 0 then return; end if;
-- Field 1: paragraph direction
Skip_WS;
if Pos <= Last and then Line (Pos) in '0' .. '2' then
Exp_Dir := Character'Pos (Line (Pos)) - Character'Pos ('0');
Pos := Pos + 1;
end if;
Skip_To_Semi;
-- Field 2: expected paragraph level
Skip_WS;
if Pos <= Last and then Line (Pos) in '0' .. '9' then
Exp_Para_Level := Character'Pos (Line (Pos)) - Character'Pos ('0');
Pos := Pos + 1;
end if;
Skip_To_Semi;
-- Field 3: expected levels (space-separated, 'x' for removed)
Skip_WS;
while Pos <= Last and then Line (Pos) /= ';' loop
Skip_WS;
if Pos > Last or else Line (Pos) = ';' then exit; end if;
if Line (Pos) = 'x' then
Num_Exp_Levels := Num_Exp_Levels + 1;
if Num_Exp_Levels <= Max_Paragraph_CPs then
Exp_Levels (Num_Exp_Levels) := -1;
end if;
Pos := Pos + 1;
elsif Line (Pos) in '0' .. '9' then
declare
Val : Natural := 0;
begin
while Pos <= Last and then Line (Pos) in '0' .. '9' loop
Val := Val * 10 +
(Character'Pos (Line (Pos)) - Character'Pos ('0'));
Pos := Pos + 1;
end loop;
Num_Exp_Levels := Num_Exp_Levels + 1;
if Num_Exp_Levels <= Max_Paragraph_CPs then
Exp_Levels (Num_Exp_Levels) := Val;
end if;
end;
else
Pos := Pos + 1;
end if;
end loop;
Skip_To_Semi;
-- Field 4: expected reorder indices (space-separated)
Skip_WS;
while Pos <= Last loop
Skip_WS;
if Pos > Last then exit; end if;
if Line (Pos) in '0' .. '9' then
declare
Val : Natural := 0;
begin
while Pos <= Last and then Line (Pos) in '0' .. '9' loop
Val := Val * 10 +
(Character'Pos (Line (Pos)) - Character'Pos ('0'));
Pos := Pos + 1;
end loop;
Num_Exp_Order := Num_Exp_Order + 1;
if Num_Exp_Order <= Max_Paragraph_CPs then
Exp_Order (Num_Exp_Order) := Val;
end if;
end;
else
Pos := Pos + 1;
end if;
end loop;
-- Encode codepoints to UTF-8
Buf.Len := 0;
for I in 1 .. Num_CPs_Parsed loop
Encode_CP (Buf, CP_List (I));
end loop;
if Buf.Len = 0 then return; end if;
-- Determine direction
Dir := (case Exp_Dir is
when 0 => Dir_LTR,
when 1 => Dir_RTL,
when others => Dir_Auto);
-- Run Resolve_Levels
Resolve_Levels
(Text => Buf.Data (1 .. Buf.Len),
Dir => Dir,
Levels => Levels_Out,
Num_CPs => Num_CPs_Out,
Para_Level => Para_Level_Out,
Success => Success);
Total := Total + 1;
if not Success then
if Failed < Max_Failures_Shown then
Ada.Text_IO.Put_Line
("FAIL line" & Positive'Image (Line_Num) &
": Resolve_Levels failed");
end if;
Failed := Failed + 1;
return;
end if;
-- Check paragraph level
if Natural (Para_Level_Out) /= Exp_Para_Level then
Para_Level_Match := False;
end if;
-- Check levels (compare non-x positions)
if Natural (Num_CPs_Out) /= Num_Exp_Levels then
Level_Match := False;
else
for I in 1 .. Num_Exp_Levels loop
if Exp_Levels (I) >= 0 then
-- Non-x position: compare
if Natural (Levels_Out (I)) /= Exp_Levels (I) then
Level_Match := False;
exit;
end if;
end if;
end loop;
end if;
-- Run Reorder
Reorder
(Levels => Levels_Out,
Num_CPs => Num_CPs_Out,
Para_Level => Para_Level_Out,
Order => Order_Out,
Success => Success);
if not Success then
if Failed < Max_Failures_Shown then
Ada.Text_IO.Put_Line
("FAIL line" & Positive'Image (Line_Num) &
": Reorder failed");
end if;
Failed := Failed + 1;
return;
end if;
-- Check reorder: build the expected mapping
-- The test file gives 0-based visual order indices for non-x positions
-- We need to compare our Order output (which is 1-based logical→visual)
-- against the expected visual order.
--
-- The expected reorder field lists the logical indices (0-based)
-- in visual order, excluding x positions.
--
-- Our Reorder output Order(1..N) gives logical indices (1-based)
-- for each visual position.
--
-- To compare: filter out x positions from our output and compare.
if Num_Exp_Order > 0 then
declare
-- Build filtered order (skip x positions)
Filtered : array (1 .. Max_Paragraph_CPs) of Integer :=
[others => -1];
Filtered_Len : Natural := 0;
begin
for I in 1 .. Num_CPs_Out loop
declare
Logical_Idx : constant Natural := Order_Out (I);
begin
if Logical_Idx >= 1
and then Logical_Idx <= Num_Exp_Levels
and then Exp_Levels (Logical_Idx) >= 0
then
-- Non-x position: include in filtered output
Filtered_Len := Filtered_Len + 1;
if Filtered_Len <= Max_Paragraph_CPs then
Filtered (Filtered_Len) := Logical_Idx - 1;
-- Convert to 0-based for comparison
end if;
end if;
end;
end loop;
if Filtered_Len /= Num_Exp_Order then
Order_Match := False;
else
for I in 1 .. Num_Exp_Order loop
if Filtered (I) /= Exp_Order (I) then
Order_Match := False;
exit;
end if;
end loop;
end if;
end;
end if;
if Para_Level_Match and Level_Match and Order_Match then
Passed := Passed + 1;
else
Failed := Failed + 1;
if Failed <= Max_Failures_Shown then
Ada.Text_IO.Put ("FAIL line" & Positive'Image (Line_Num) & ":");
if not Para_Level_Match then
Ada.Text_IO.Put (" para_level(got" &
Embedding_Level'Image (Para_Level_Out) &
" exp" & Natural'Image (Exp_Para_Level) & ")");
end if;
if not Level_Match then
Ada.Text_IO.Put (" levels");
if Natural (Num_CPs_Out) /= Num_Exp_Levels then
Ada.Text_IO.Put ("(count" &
Natural'Image (Natural (Num_CPs_Out)) &
" vs" & Natural'Image (Num_Exp_Levels) & ")");
else
for I in 1 .. Num_Exp_Levels loop
if Exp_Levels (I) >= 0
and then Natural (Levels_Out (I)) /= Exp_Levels (I)
then
Ada.Text_IO.Put ("(pos" & Positive'Image (I) &
" got" & Embedding_Level'Image (Levels_Out (I)) &
" exp" & Integer'Image (Exp_Levels (I)) & ")");
exit;
end if;
end loop;
end if;
end if;
if not Order_Match then
Ada.Text_IO.Put (" order");
end if;
Ada.Text_IO.New_Line;
end if;
end if;
end Process_Line;
---------------------------------------------------------------------------
-- Main
---------------------------------------------------------------------------
UCD_Dir : constant String :=
(if Ada.Command_Line.Argument_Count >= 1
then Ada.Command_Line.Argument (1) else "ucd");
Test_File : constant String := UCD_Dir & "/BidiCharacterTest.txt";
F : Ada.Text_IO.File_Type;
Line_Num : Positive := 1;
Success : Boolean;
begin
-- Initialize properties
Properties.Initialize (UCD_Dir, Success);
if not Success then
Ada.Text_IO.Put_Line ("ERROR: Failed to initialize Properties");
Ada.Command_Line.Set_Exit_Status (1);
return;
end if;
-- Initialize bidi
Bidi.Initialize (UCD_Dir, Success);
if not Success then
Ada.Text_IO.Put_Line ("ERROR: Failed to initialize Bidi");
Ada.Command_Line.Set_Exit_Status (1);
return;
end if;
-- Open test file
Ada.Text_IO.Open (F, Ada.Text_IO.In_File, Test_File);
while not Ada.Text_IO.End_Of_File (F) loop
declare
Line : constant String := Ada.Text_IO.Get_Line (F);
begin
-- Skip comments and blank lines
if Line'Length > 0
and then Line (Line'First) /= '#'
and then Line (Line'First) /= ASCII.LF
and then Line (Line'First) /= ASCII.CR
then
-- Must have at least one semicolon to be a data line
declare
Has_Semi : Boolean := False;
begin
for I in Line'Range loop
if Line (I) = ';' then
Has_Semi := True;
exit;
end if;
end loop;
if Has_Semi then
Process_Line (Line, Line_Num);
end if;
end;
end if;
end;
Line_Num := Line_Num + 1;
end loop;
Ada.Text_IO.Close (F);
-- Summary
Ada.Text_IO.Put_Line ("Total:" & Natural'Image (Total));
Ada.Text_IO.Put_Line ("Passed:" & Natural'Image (Passed));
Ada.Text_IO.Put_Line ("Failed:" & Natural'Image (Failed));
Ada.Text_IO.New_Line;
if Failed = 0 then
Ada.Text_IO.Put_Line ("ALL TESTS PASSED");
else
Ada.Text_IO.Put_Line ("SOME TESTS FAILED");
Ada.Command_Line.Set_Exit_Status (1);
end if;
end Test_Bidi;