-- 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 — Properties smoke test
--
-- Loads Scripts.txt from disk, looks up known codepoints, verifies
-- that the script names match expected values.
-------------------------------------------------------------------------------
with Ada.Text_IO;
with Lingenic_Text.Properties;
with Lingenic_Text.UCD_Parser;
with Lingenic_Text.Scx_Parser;
with Lingenic_Text.Bidi;
with Lingenic_Text.Bidi_Spec;
procedure Test_Properties is
use Ada.Text_IO;
use Lingenic_Text;
use Lingenic_Text.Properties;
use Lingenic_Text.UCD_Parser;
Success : Boolean;
Passed : Natural := 0;
Failed : Natural := 0;
procedure Check
(CP : Codepoint;
Expected_Name : String)
is
Idx : Property_Index;
begin
Idx := Get_Script (CP);
if Idx = Default_Index then
Put_Line ("FAIL: U+" & Codepoint'Image (CP) &
" => index 0 (default), expected """ &
Expected_Name & """");
Failed := Failed + 1;
return;
end if;
if Idx > Script_Name_Count then
Put_Line ("FAIL: U+" & Codepoint'Image (CP) &
" => index" & Property_Index'Image (Idx) &
" out of range (max" &
Property_Index'Image (Script_Name_Count) & ")");
Failed := Failed + 1;
return;
end if;
declare
Got : constant String := Script_Name (Idx);
begin
if Got = Expected_Name then
Passed := Passed + 1;
else
Put_Line ("FAIL: U+" & Codepoint'Image (CP) &
" => """ & Got & """, expected """ &
Expected_Name & """");
Failed := Failed + 1;
end if;
end;
end Check;
-----------------------------------------------------------------------
-- Bidi_Mirrored property check (UnicodeData.txt field 9, UAX #9 L4)
-----------------------------------------------------------------------
procedure Check_Mirror
(CP : Codepoint;
Expected : Boolean)
is
Got : constant Boolean := Get_Bidi_Mirrored (CP);
begin
if Got = Expected then
Passed := Passed + 1;
else
Put_Line ("FAIL: Get_Bidi_Mirrored(U+" &
Codepoint'Image (CP) & ") = " &
Boolean'Image (Got) & ", expected " &
Boolean'Image (Expected));
Failed := Failed + 1;
end if;
end Check_Mirror;
-----------------------------------------------------------------------
-- Needs_Mirror check — combines level parity with Bidi_Mirrored
-----------------------------------------------------------------------
procedure Check_L4
(CP : Codepoint;
Level : Bidi_Spec.Embedding_Level;
Expected : Boolean)
is
Got : constant Boolean := Bidi.Needs_Mirror (CP, Level);
begin
if Got = Expected then
Passed := Passed + 1;
else
Put_Line ("FAIL: Needs_Mirror(U+" &
Codepoint'Image (CP) & ", level" &
Bidi_Spec.Embedding_Level'Image (Level) & ") = " &
Boolean'Image (Got) & ", expected " &
Boolean'Image (Expected));
Failed := Failed + 1;
end if;
end Check_L4;
begin
Put_Line ("=== Lingenic-Text Properties Test ===");
Put_Line ("");
-- Initialize from UCD directory
Put_Line ("Initializing...");
Initialize ("ucd", Success);
if not Success then
Put_Line ("FAIL: Initialize returned False");
Put_Line (" (looked for ucd/Scripts.txt)");
return;
end if;
Put_Line ("Initialize: OK");
Put_Line ("Script value count:" &
Property_Index'Image (Script_Name_Count));
Put_Line ("");
-- List first 10 discovered script names
Put_Line ("--- First 10 script names ---");
for I in 1 .. Natural'Min (10, Script_Name_Count) loop
Put_Line (" " & Property_Index'Image (I) & ": " & Script_Name (I));
end loop;
Put_Line ("");
-- Test known codepoints
Put_Line ("--- Codepoint checks ---");
-- Basic Latin
Check (16#0041#, "Latin"); -- A
Check (16#0061#, "Latin"); -- a
Check (16#007A#, "Latin"); -- z
-- Greek
Check (16#0391#, "Greek"); -- Alpha
Check (16#03B1#, "Greek"); -- alpha
Check (16#03C9#, "Greek"); -- omega
-- Cyrillic
Check (16#0410#, "Cyrillic"); -- A
Check (16#044F#, "Cyrillic"); -- ya
-- Arabic
Check (16#0627#, "Arabic"); -- alef
Check (16#0628#, "Arabic"); -- ba
-- Devanagari
Check (16#0905#, "Devanagari"); -- a
-- Han (CJK Unified Ideographs)
Check (16#4E00#, "Han"); -- yi (one)
Check (16#9FFF#, "Han"); -- last CJK URO
-- Hiragana
Check (16#3042#, "Hiragana"); -- a
-- Katakana
Check (16#30A2#, "Katakana"); -- a
-- Hangul
Check (16#AC00#, "Hangul"); -- ga
Check (16#D7A3#, "Hangul"); -- hih
-- Common (ASCII digits, punctuation)
Check (16#0030#, "Common"); -- 0
Check (16#0020#, "Common"); -- space
-- Inherited
Check (16#0300#, "Inherited"); -- combining grave
-- Bidi_Mirrored property (UnicodeData.txt field 9)
Put_Line ("");
Put_Line ("--- Bidi_Mirrored checks ---");
-- Characters with Bidi_Mirrored = Y
Check_Mirror (16#0028#, True); -- '('
Check_Mirror (16#0029#, True); -- ')'
Check_Mirror (16#003C#, True); -- '<'
Check_Mirror (16#003E#, True); -- '>'
Check_Mirror (16#005B#, True); -- '['
Check_Mirror (16#005D#, True); -- ']'
Check_Mirror (16#007B#, True); -- '{'
Check_Mirror (16#007D#, True); -- '}'
Check_Mirror (16#00AB#, True); -- '«'
Check_Mirror (16#00BB#, True); -- '»'
Check_Mirror (16#2308#, True); -- LEFT CEILING
Check_Mirror (16#2309#, True); -- RIGHT CEILING
-- Characters with Bidi_Mirrored = N
Check_Mirror (16#0041#, False); -- 'A'
Check_Mirror (16#0061#, False); -- 'a'
Check_Mirror (16#0030#, False); -- '0'
Check_Mirror (16#0020#, False); -- space
Check_Mirror (16#002E#, False); -- '.'
Check_Mirror (16#0627#, False); -- arabic alef
Check_Mirror (16#4E00#, False); -- CJK 'one'
-- UAX #9 L4 decision: needs mirror iff odd level AND Bidi_Mirrored
Put_Line ("");
Put_Line ("--- Needs_Mirror (L4) checks ---");
-- '(' at LTR levels: never mirrored regardless of property
Check_L4 (16#0028#, 0, False); -- even level
Check_L4 (16#0028#, 2, False); -- even level
Check_L4 (16#0028#, 4, False); -- even level
-- '(' at RTL levels: mirrored because Bidi_Mirrored=Y
Check_L4 (16#0028#, 1, True); -- odd level
Check_L4 (16#0028#, 3, True); -- odd level
-- ')' mirrors the same way
Check_L4 (16#0029#, 0, False);
Check_L4 (16#0029#, 1, True);
-- 'A' is not mirrored at any level (Bidi_Mirrored=N)
Check_L4 (16#0041#, 0, False);
Check_L4 (16#0041#, 1, False);
Check_L4 (16#0041#, 2, False);
Check_L4 (16#0041#, 3, False);
-- Arabic alef at odd level: NOT mirrored (Bidi_Mirrored=N)
Check_L4 (16#0627#, 1, False);
-- '[' at odd level: mirrored
Check_L4 (16#005B#, 1, True);
-- '[' at even level: not mirrored
Check_L4 (16#005B#, 0, False);
-- Script_Extensions property (UAX #24)
Put_Line ("");
Put_Line ("--- Script_Extensions checks ---");
-- Helper: find the script index for a given name
declare
function Find_Script (Name : String) return UCD_Parser.Property_Index is
begin
for I in 1 .. Script_Name_Count loop
if Script_Name (I) = Name then
return I;
end if;
end loop;
return 0;
end Find_Script;
Latin_Idx : constant UCD_Parser.Property_Index := Find_Script ("Latin");
Greek_Idx : constant UCD_Parser.Property_Index := Find_Script ("Greek");
Bopo_Idx : constant UCD_Parser.Property_Index := Find_Script ("Bopomofo");
Deva_Idx : constant UCD_Parser.Property_Index := Find_Script ("Devanagari");
Beng_Idx : constant UCD_Parser.Property_Index := Find_Script ("Bengali");
procedure Check_Scx
(CP : Codepoint;
Idx : UCD_Parser.Property_Index;
Expected : Boolean;
Desc : String)
is
begin
if Idx = 0 then
Put_Line ("SKIP: " & Desc & " — script name not found");
return;
end if;
declare
Got : constant Boolean :=
Is_In_Script_Extensions (CP, Idx);
begin
if Got = Expected then
Passed := Passed + 1;
else
Put_Line ("FAIL: " & Desc & " = " &
Boolean'Image (Got) & ", expected " &
Boolean'Image (Expected));
Failed := Failed + 1;
end if;
end;
end Check_Scx;
begin
-- U+0041 (A): not in ScriptExtensions.txt, primary script = Latin.
-- Should be IN Latin, NOT in Greek.
Check_Scx (16#0041#, Latin_Idx, True,
"Is_In_Scx(A, Latin)");
Check_Scx (16#0041#, Greek_Idx, False,
"Is_In_Scx(A, Greek)");
-- U+02C7 (CARON): ScriptExtensions = {Bopomofo, Latin}.
-- Should be IN both Bopomofo and Latin, NOT in Greek.
Check_Scx (16#02C7#, Latin_Idx, True,
"Is_In_Scx(CARON, Latin)");
Check_Scx (16#02C7#, Bopo_Idx, True,
"Is_In_Scx(CARON, Bopomofo)");
Check_Scx (16#02C7#, Greek_Idx, False,
"Is_In_Scx(CARON, Greek)");
-- U+0951 (DEVANAGARI STRESS SIGN UDATTA): many scripts incl.
-- Bengali, Devanagari, Latin.
Check_Scx (16#0951#, Deva_Idx, True,
"Is_In_Scx(UDATTA, Devanagari)");
Check_Scx (16#0951#, Beng_Idx, True,
"Is_In_Scx(UDATTA, Bengali)");
Check_Scx (16#0951#, Latin_Idx, True,
"Is_In_Scx(UDATTA, Latin)");
Check_Scx (16#0951#, Greek_Idx, False,
"Is_In_Scx(UDATTA, Greek)");
-- Get_Script_Extension_Count checks
-- U+0041 (A): not in ScriptExtensions.txt → count = 1
declare
C : constant Scx_Parser.Scx_Member_Count :=
Get_Script_Extension_Count (16#0041#);
begin
if C = 1 then
Passed := Passed + 1;
else
Put_Line ("FAIL: Scx_Count(A) =" &
Scx_Parser.Scx_Member_Count'Image (C) &
", expected 1");
Failed := Failed + 1;
end if;
end;
-- U+02C7 (CARON): ScriptExtensions = {Bopo, Latn} → count = 2
declare
C : constant Scx_Parser.Scx_Member_Count :=
Get_Script_Extension_Count (16#02C7#);
begin
if C = 2 then
Passed := Passed + 1;
else
Put_Line ("FAIL: Scx_Count(CARON) =" &
Scx_Parser.Scx_Member_Count'Image (C) &
", expected 2");
Failed := Failed + 1;
end if;
end;
-- U+0951: ScriptExtensions has many scripts (14 in Unicode 17.0)
declare
C : constant Scx_Parser.Scx_Member_Count :=
Get_Script_Extension_Count (16#0951#);
begin
if C >= 10 then
Passed := Passed + 1;
Put_Line (" Scx_Count(UDATTA) =" &
Scx_Parser.Scx_Member_Count'Image (C));
else
Put_Line ("FAIL: Scx_Count(UDATTA) =" &
Scx_Parser.Scx_Member_Count'Image (C) &
", expected >= 10");
Failed := Failed + 1;
end if;
end;
end;
Put_Line ("");
Put_Line ("=== Results ===");
Put_Line ("Passed:" & Natural'Image (Passed));
Put_Line ("Failed:" & Natural'Image (Failed));
if Failed = 0 then
Put_Line ("ALL TESTS PASSED");
end if;
end Test_Properties;