-- 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 — Grapheme property smoke test
--
-- Verifies that GBP, ExtPict, and InCB properties load correctly
-- and return expected values for known codepoints.
-------------------------------------------------------------------------------
with Ada.Text_IO;
with Lingenic_Text.Properties;
with Lingenic_Text.UCD_Parser;
with Lingenic_Text.Graphemes_Spec;
procedure Test_Grapheme_Props is
use Ada.Text_IO;
use Lingenic_Text;
use Lingenic_Text.Properties;
use Lingenic_Text.UCD_Parser;
use Lingenic_Text.Graphemes_Spec;
Success : Boolean;
Passed : Natural := 0;
Failed : Natural := 0;
procedure Check_GBP
(CP : Codepoint;
Expected_Name : String;
Label : String)
is
Idx : constant Property_Index := Get_GBP (CP);
begin
if Idx = Default_Index then
if Expected_Name = "Other" then
Passed := Passed + 1;
else
Put_Line ("FAIL GBP: " & Label & " => index 0 (Other)," &
" expected """ & Expected_Name & """");
Failed := Failed + 1;
end if;
return;
end if;
if Idx > GBP_Name_Count then
Put_Line ("FAIL GBP: " & Label & " => index" &
Property_Index'Image (Idx) & " out of range");
Failed := Failed + 1;
return;
end if;
declare
Got : constant String := GBP_Name (Idx);
begin
if Got = Expected_Name then
Passed := Passed + 1;
else
Put_Line ("FAIL GBP: " & Label & " => """ & Got &
""", expected """ & Expected_Name & """");
Failed := Failed + 1;
end if;
end;
end Check_GBP;
procedure Check_GBP_Abstract
(CP : Codepoint;
Expected : GBP_Value;
Label : String)
is
Idx : constant Property_Index := Get_GBP (CP);
Got : constant GBP_Value := GBP_To_Abstract (Idx);
begin
if Got = Expected then
Passed := Passed + 1;
else
Put_Line ("FAIL GBP_Abstract: " & Label & " =>" &
GBP_Value'Image (Got) & ", expected" &
GBP_Value'Image (Expected));
Failed := Failed + 1;
end if;
end Check_GBP_Abstract;
procedure Check_ExtPict
(CP : Codepoint;
Expected : Boolean;
Label : String)
is
Got : constant Boolean := Get_ExtPict (CP);
begin
if Got = Expected then
Passed := Passed + 1;
else
Put_Line ("FAIL ExtPict: " & Label & " => " &
Boolean'Image (Got) & ", expected " &
Boolean'Image (Expected));
Failed := Failed + 1;
end if;
end Check_ExtPict;
procedure Check_InCB_Abstract
(CP : Codepoint;
Expected : InCB_Value;
Label : String)
is
Idx : constant Property_Index := Get_InCB (CP);
Got : constant InCB_Value := InCB_To_Abstract (Idx);
begin
if Got = Expected then
Passed := Passed + 1;
else
Put_Line ("FAIL InCB_Abstract: " & Label & " =>" &
InCB_Value'Image (Got) & ", expected" &
InCB_Value'Image (Expected));
Failed := Failed + 1;
end if;
end Check_InCB_Abstract;
begin
Put_Line ("=== Lingenic-Text Grapheme Properties Test ===");
Put_Line ("");
Initialize ("ucd", Success);
if not Success then
Put_Line ("FAIL: Initialize returned False");
return;
end if;
Put_Line ("Initialize: OK");
Put_Line ("GBP value count:" & Property_Index'Image (GBP_Name_Count));
Put_Line ("InCB value count:" & Property_Index'Image (InCB_Name_Count));
Put_Line ("");
-- List GBP names
Put_Line ("--- GBP names ---");
for I in 1 .. GBP_Name_Count loop
Put_Line (" " & Property_Index'Image (I) & ": " & GBP_Name (I) &
" => abstract" & GBP_Value'Image (GBP_To_Abstract (I)));
end loop;
Put_Line ("");
-- GBP checks by name
Put_Line ("--- GBP checks ---");
Check_GBP (16#000D#, "CR", "U+000D CR");
Check_GBP (16#000A#, "LF", "U+000A LF");
Check_GBP (16#0000#, "Control", "U+0000 NUL");
Check_GBP (16#0300#, "Extend", "U+0300 combining grave");
Check_GBP (16#200D#, "ZWJ", "U+200D ZWJ");
Check_GBP (16#1F1E6#, "Regional_Indicator", "U+1F1E6 RI-A");
Check_GBP (16#0600#, "Prepend", "U+0600 Arabic number sign");
Check_GBP (16#0903#, "SpacingMark", "U+0903 Devanagari visarga");
Check_GBP (16#1100#, "L", "U+1100 Hangul L");
Check_GBP (16#1160#, "V", "U+1160 Hangul V");
Check_GBP (16#11A8#, "T", "U+11A8 Hangul T");
Check_GBP (16#AC00#, "LV", "U+AC00 Hangul ga (LV)");
Check_GBP (16#AC01#, "LVT", "U+AC01 Hangul gag (LVT)");
Check_GBP (16#0041#, "Other", "U+0041 A (Other)");
Put_Line ("");
-- GBP abstract value checks
Put_Line ("--- GBP abstract value checks ---");
Check_GBP_Abstract (16#000D#, GBP_CR, "U+000D CR");
Check_GBP_Abstract (16#000A#, GBP_LF, "U+000A LF");
Check_GBP_Abstract (16#200D#, GBP_ZWJ, "U+200D ZWJ");
Check_GBP_Abstract (16#1F1E6#, GBP_Regional_Indicator, "U+1F1E6 RI-A");
Check_GBP_Abstract (16#0041#, GBP_Other, "U+0041 A");
Put_Line ("");
-- ExtPict checks
Put_Line ("--- ExtPict checks ---");
Check_ExtPict (16#00A9#, True, "U+00A9 copyright");
Check_ExtPict (16#00AE#, True, "U+00AE registered");
Check_ExtPict (16#203C#, True, "U+203C double exclamation");
Check_ExtPict (16#2764#, True, "U+2764 heavy black heart");
Check_ExtPict (16#1F600#, True, "U+1F600 grinning face");
Check_ExtPict (16#1F64F#, True, "U+1F64F folded hands");
Check_ExtPict (16#0041#, False, "U+0041 A (not ExtPict)");
Check_ExtPict (16#0300#, False, "U+0300 combining grave (not ExtPict)");
Put_Line ("");
-- InCB checks
Put_Line ("--- InCB checks ---");
Check_InCB_Abstract (16#0915#, InCB_Consonant, "U+0915 Devanagari KA");
Check_InCB_Abstract (16#094D#, InCB_Linker, "U+094D Devanagari virama");
Check_InCB_Abstract (16#0941#, InCB_Extend, "U+0941 Devanagari vowel U");
Check_InCB_Abstract (16#0041#, InCB_None, "U+0041 A (none)");
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_Grapheme_Props;