-- 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 — Case mapping conformance test
--
-- Verifies case mapping operations against the Unicode data files:
--
-- 1. SpecialCasing.txt — every unconditional entry:
-- for codepoint CP with lower/title/upper fields,
-- verify Lowercase(CP) = lower, Titlecase(CP) = title,
-- Uppercase(CP) = upper
--
-- 2. CaseFolding.txt — every C and F entry:
-- for codepoint CP with mapping M,
-- verify Casefold(CP) = M
--
-- 3. UnicodeData.txt — every simple mapping (fields 12/13/14):
-- for codepoint CP with simple uppercase/lowercase/titlecase U/L/T,
-- verify Uppercase(CP) produces U (unless overridden by SpecialCasing),
-- Lowercase(CP) produces L, Titlecase(CP) produces T
--
-- 4. Final_Sigma context tests:
-- medial vs final sigma in various contexts
--
-- The data files ARE the spec. Every entry is a test case.
-------------------------------------------------------------------------------
with Ada.Text_IO;
with Ada.Strings.Fixed;
with Lingenic_Text.Case_Mapping;
with Lingenic_Text.Properties;
with Lingenic_Text.UTF8;
procedure Test_Case_Mapping is
use Ada.Text_IO;
use Lingenic_Text;
use Lingenic_Text.Case_Mapping;
Init_OK : Boolean;
Total : Natural := 0;
Passed : Natural := 0;
Failed : Natural := 0;
---------------------------------------------------------------------------
-- Hex parsing
---------------------------------------------------------------------------
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;
---------------------------------------------------------------------------
-- UTF-8 encoding helpers
---------------------------------------------------------------------------
Max_Bytes : constant := 64;
type UTF8_Buffer is record
Data : Byte_Array (1 .. Max_Bytes) := [others => 0];
Len : Natural := 0;
end record;
procedure Encode_CP
(CP : Codepoint;
Buf : in out UTF8_Buffer)
is
Pos : Positive;
Enc_Len : Positive;
begin
if Buf.Len >= Max_Bytes - 3 then
return;
end if;
Pos := Buf.Len + 1;
if Is_Scalar_Value (CP) then
UTF8.Encode (CP, Buf.Data, Pos, Enc_Len);
Buf.Len := Buf.Len + Enc_Len;
end if;
end Encode_CP;
---------------------------------------------------------------------------
-- Byte array comparison
---------------------------------------------------------------------------
function Bytes_Equal
(A : Byte_Array; A_Len : Natural;
B : Byte_Array; B_Len : Natural) return Boolean
is
begin
if A_Len /= B_Len then
return False;
end if;
for I in 0 .. A_Len - 1 loop
if A (A'First + I) /= B (B'First + I) then
return False;
end if;
end loop;
return True;
end Bytes_Equal;
---------------------------------------------------------------------------
-- Hex printing for diagnostics
---------------------------------------------------------------------------
Hex_Digits : constant String := "0123456789ABCDEF";
procedure Print_Hex (Buf : Byte_Array; Len : Natural) is
begin
for I in 0 .. Len - 1 loop
if I > 0 then
Put (" ");
end if;
Put (Hex_Digits (Buf (Buf'First + I) / 16 + 1));
Put (Hex_Digits (Buf (Buf'First + I) mod 16 + 1));
end loop;
end Print_Hex;
---------------------------------------------------------------------------
-- Parse a field of space-separated hex codepoints from a string.
-- Returns a UTF-8 encoded buffer.
---------------------------------------------------------------------------
procedure Parse_CP_Field
(S : String;
Buf : out UTF8_Buffer)
is
I : Positive := S'First;
Start : Positive;
CP : Natural;
begin
Buf := (Data => [others => 0], Len => 0);
while I <= S'Last loop
-- Skip spaces
while I <= S'Last and then S (I) = ' ' loop
I := I + 1;
end loop;
exit when I > S'Last;
-- Collect hex digits
Start := I;
while I <= S'Last and then S (I) /= ' ' loop
I := I + 1;
end loop;
CP := Hex_To_CP (S (Start .. I - 1));
if CP <= Max_Codepoint and then Is_Scalar_Value (CP) then
Encode_CP (CP, Buf);
end if;
end loop;
end Parse_CP_Field;
---------------------------------------------------------------------------
-- Run one case mapping check
---------------------------------------------------------------------------
Out_Buf : Byte_Array (1 .. 256) := [others => 0];
procedure Check_Mapping
(Label : String;
Op : String;
Input : UTF8_Buffer;
Expected : UTF8_Buffer)
is
Last : Natural;
Status : Case_Status;
Got_Len : Natural;
begin
Total := Total + 1;
Out_Buf := [others => 0];
if Input.Len = 0 then
Passed := Passed + 1;
return;
end if;
if Op = "upper" then
Uppercase (Input.Data (1 .. Input.Len), Out_Buf, Last, Status);
elsif Op = "lower" then
Lowercase (Input.Data (1 .. Input.Len), Out_Buf, Last, Status);
elsif Op = "title" then
Titlecase (Input.Data (1 .. Input.Len), Out_Buf, Last, Status);
elsif Op = "fold" then
Casefold (Input.Data (1 .. Input.Len), Out_Buf, Last, Status);
else
Failed := Failed + 1;
Put_Line ("ERROR: unknown op " & Op);
return;
end if;
if Status /= Success then
Failed := Failed + 1;
Put_Line ("FAIL: " & Label & " — status "
& (if Status = Buffer_Overflow then "Buffer_Overflow"
else "Invalid_Input"));
return;
end if;
Got_Len := Last - Out_Buf'First + 1;
if Bytes_Equal (Out_Buf, Got_Len, Expected.Data, Expected.Len) then
Passed := Passed + 1;
else
Failed := Failed + 1;
Put ("FAIL: " & Label & " — got [");
Print_Hex (Out_Buf, Got_Len);
Put ("], expected [");
Print_Hex (Expected.Data, Expected.Len);
Put_Line ("]");
end if;
end Check_Mapping;
---------------------------------------------------------------------------
-- String field extraction helpers
---------------------------------------------------------------------------
-- Find the Nth semicolon-delimited field in line S.
-- Field 0 = before first semicolon, field 1 = after first, etc.
function Get_Field (S : String; Field : Natural) return String is
Start : Positive := S'First;
Count : Natural := 0;
I : Positive;
begin
-- Skip to field
I := S'First;
while Count < Field and I <= S'Last loop
if S (I) = ';' then
Count := Count + 1;
end if;
I := I + 1;
end loop;
Start := I;
-- Find end of field
while I <= S'Last and then S (I) /= ';' loop
I := I + 1;
end loop;
return Ada.Strings.Fixed.Trim (S (Start .. I - 1), Ada.Strings.Both);
end Get_Field;
-- Count semicolons before '#' or end of line
function Count_Semicolons (S : String) return Natural is
N : Natural := 0;
begin
for I in S'Range loop
if S (I) = '#' then
exit;
end if;
if S (I) = ';' then
N := N + 1;
end if;
end loop;
return N;
end Count_Semicolons;
-- Check if line is a data line (non-empty, non-comment)
function Is_Data_Line (S : String) return Boolean is
begin
if S'Length = 0 then
return False;
end if;
for I in S'Range loop
if S (I) = '#' then
return False;
end if;
if S (I) /= ' ' and S (I) /= ASCII.HT then
return True;
end if;
end loop;
return False;
end Is_Data_Line;
---------------------------------------------------------------------------
-- Test 1: SpecialCasing.txt — unconditional entries
---------------------------------------------------------------------------
SC_Total : Natural := 0;
procedure Test_SpecialCasing is
File : Ada.Text_IO.File_Type;
Input : UTF8_Buffer;
Exp_Lo : UTF8_Buffer;
Exp_Ti : UTF8_Buffer;
Exp_Up : UTF8_Buffer;
begin
Put ("SpecialCasing.txt: ");
Open (File, In_File, "ucd/SpecialCasing.txt");
while not End_Of_File (File) loop
declare
Line : constant String := Get_Line (File);
begin
if Is_Data_Line (Line) then
-- Unconditional entries have exactly 4 semicolons
-- (code; lower; title; upper; # comment)
-- Conditional have 5+ (extra condition field)
if Count_Semicolons (Line) = 4 then
declare
Code_S : constant String := Get_Field (Line, 0);
Lower_S : constant String := Get_Field (Line, 1);
Title_S : constant String := Get_Field (Line, 2);
Upper_S : constant String := Get_Field (Line, 3);
CP : constant Natural := Hex_To_CP (Code_S);
Label : constant String :=
"SC U+" & Code_S;
begin
if CP <= Max_Codepoint
and then Is_Scalar_Value (CP)
then
-- Encode source codepoint
Input := (Data => [others => 0], Len => 0);
Encode_CP (CP, Input);
-- Parse expected mappings
Parse_CP_Field (Lower_S, Exp_Lo);
Parse_CP_Field (Title_S, Exp_Ti);
Parse_CP_Field (Upper_S, Exp_Up);
-- Test uppercase
Check_Mapping (Label & " upper", "upper",
Input, Exp_Up);
-- Test titlecase
Check_Mapping (Label & " title", "title",
Input, Exp_Ti);
-- Test lowercase
Check_Mapping (Label & " lower", "lower",
Input, Exp_Lo);
SC_Total := SC_Total + 3;
end if;
end;
end if;
end if;
end;
end loop;
Close (File);
Put_Line (Natural'Image (SC_Total) & " tests");
end Test_SpecialCasing;
---------------------------------------------------------------------------
-- Test 2: CaseFolding.txt — C and F entries
---------------------------------------------------------------------------
CF_Total : Natural := 0;
procedure Test_CaseFolding is
File : Ada.Text_IO.File_Type;
Input : UTF8_Buffer;
Expected : UTF8_Buffer;
begin
Put ("CaseFolding.txt: ");
Open (File, In_File, "ucd/CaseFolding.txt");
while not End_Of_File (File) loop
declare
Line : constant String := Get_Line (File);
begin
if Is_Data_Line (Line) then
declare
Code_S : constant String := Get_Field (Line, 0);
Status_S : constant String := Get_Field (Line, 1);
Map_S : constant String := Get_Field (Line, 2);
CP : constant Natural := Hex_To_CP (Code_S);
begin
-- Only test C (common) and F (full) entries
if (Status_S = "C" or Status_S = "F")
and then CP <= Max_Codepoint
and then Is_Scalar_Value (CP)
then
Input := (Data => [others => 0], Len => 0);
Encode_CP (CP, Input);
Parse_CP_Field (Map_S, Expected);
Check_Mapping ("CF U+" & Code_S, "fold",
Input, Expected);
CF_Total := CF_Total + 1;
end if;
end;
end if;
end;
end loop;
Close (File);
Put_Line (Natural'Image (CF_Total) & " tests");
end Test_CaseFolding;
---------------------------------------------------------------------------
-- Test 3: UnicodeData.txt — simple case mappings (fields 12, 13, 14)
--
-- For each codepoint with a simple mapping in field 12/13/14,
-- verify the operation produces the expected result.
-- Skip codepoints that have SpecialCasing overrides (those were already
-- tested above and the SpecialCasing mapping takes precedence).
---------------------------------------------------------------------------
UD_Total : Natural := 0;
-- Track which codepoints have SpecialCasing overrides
type Override_Set is array (0 .. Max_Codepoint) of Boolean;
SC_Upper_Override : Override_Set := [others => False];
SC_Lower_Override : Override_Set := [others => False];
SC_Title_Override : Override_Set := [others => False];
procedure Load_SC_Overrides is
File : Ada.Text_IO.File_Type;
begin
Open (File, In_File, "ucd/SpecialCasing.txt");
while not End_Of_File (File) loop
declare
Line : constant String := Get_Line (File);
begin
if Is_Data_Line (Line) and then Count_Semicolons (Line) = 4 then
declare
Code_S : constant String := Get_Field (Line, 0);
CP : constant Natural := Hex_To_CP (Code_S);
begin
if CP <= Max_Codepoint then
SC_Upper_Override (CP) := True;
SC_Lower_Override (CP) := True;
SC_Title_Override (CP) := True;
end if;
end;
end if;
end;
end loop;
Close (File);
end Load_SC_Overrides;
procedure Test_UnicodeData is
File : Ada.Text_IO.File_Type;
Input : UTF8_Buffer;
Expected : UTF8_Buffer;
begin
Put ("UnicodeData.txt simple mappings: ");
Open (File, In_File, "ucd/UnicodeData.txt");
while not End_Of_File (File) loop
declare
Line : constant String := Get_Line (File);
begin
if Is_Data_Line (Line) then
declare
Code_S : constant String := Get_Field (Line, 0);
CP : constant Natural := Hex_To_CP (Code_S);
Upper_S : constant String := Get_Field (Line, 12);
Lower_S : constant String := Get_Field (Line, 13);
Title_S : constant String := Get_Field (Line, 14);
begin
if CP <= Max_Codepoint
and then Is_Scalar_Value (CP)
then
-- Test simple uppercase
if Upper_S'Length > 0
and then not SC_Upper_Override (CP)
then
Input := (Data => [others => 0], Len => 0);
Encode_CP (CP, Input);
Expected := (Data => [others => 0], Len => 0);
Encode_CP (Hex_To_CP (Upper_S), Expected);
Check_Mapping ("UD U+" & Code_S & " upper",
"upper", Input, Expected);
UD_Total := UD_Total + 1;
end if;
-- Test simple lowercase
if Lower_S'Length > 0
and then not SC_Lower_Override (CP)
then
Input := (Data => [others => 0], Len => 0);
Encode_CP (CP, Input);
Expected := (Data => [others => 0], Len => 0);
Encode_CP (Hex_To_CP (Lower_S), Expected);
Check_Mapping ("UD U+" & Code_S & " lower",
"lower", Input, Expected);
UD_Total := UD_Total + 1;
end if;
-- Test simple titlecase
if Title_S'Length > 0
and then not SC_Title_Override (CP)
then
Input := (Data => [others => 0], Len => 0);
Encode_CP (CP, Input);
Expected := (Data => [others => 0], Len => 0);
Encode_CP (Hex_To_CP (Title_S), Expected);
Check_Mapping ("UD U+" & Code_S & " title",
"title", Input, Expected);
UD_Total := UD_Total + 1;
end if;
end if;
end;
end if;
end;
end loop;
Close (File);
Put_Line (Natural'Image (UD_Total) & " tests");
end Test_UnicodeData;
---------------------------------------------------------------------------
-- Test 4: Final_Sigma context
---------------------------------------------------------------------------
FS_Total : Natural := 0;
procedure Test_Final_Sigma is
Input : UTF8_Buffer;
Expected : UTF8_Buffer;
begin
Put ("Final_Sigma context: ");
-- 4a. Medial: Cased + Σ + Cased → σ (medial)
-- "AΣB" → "aσb"
Input := (Data => [others => 0], Len => 0);
Encode_CP (16#0041#, Input); -- A
Encode_CP (16#03A3#, Input); -- Σ
Encode_CP (16#0042#, Input); -- B
Expected := (Data => [others => 0], Len => 0);
Encode_CP (16#0061#, Expected); -- a
Encode_CP (16#03C3#, Expected); -- σ medial
Encode_CP (16#0062#, Expected); -- b
Check_Mapping ("FS medial AΣB", "lower", Input, Expected);
FS_Total := FS_Total + 1;
-- 4b. Final: Cased + Σ + end → ς (final)
-- "AΣ" → "aς"
Input := (Data => [others => 0], Len => 0);
Encode_CP (16#0041#, Input);
Encode_CP (16#03A3#, Input);
Expected := (Data => [others => 0], Len => 0);
Encode_CP (16#0061#, Expected);
Encode_CP (16#03C2#, Expected); -- ς final
Check_Mapping ("FS final AΣ", "lower", Input, Expected);
FS_Total := FS_Total + 1;
-- 4c. No preceding cased: Σ alone → σ (medial)
Input := (Data => [others => 0], Len => 0);
Encode_CP (16#03A3#, Input);
Expected := (Data => [others => 0], Len => 0);
Encode_CP (16#03C3#, Expected); -- σ medial
Check_Mapping ("FS alone Σ", "lower", Input, Expected);
FS_Total := FS_Total + 1;
-- 4d. Final before non-cased: Cased + Σ + space → ς + space
Input := (Data => [others => 0], Len => 0);
Encode_CP (16#0041#, Input);
Encode_CP (16#03A3#, Input);
Encode_CP (16#0020#, Input);
Expected := (Data => [others => 0], Len => 0);
Encode_CP (16#0061#, Expected);
Encode_CP (16#03C2#, Expected); -- ς final
Encode_CP (16#0020#, Expected);
Check_Mapping ("FS final AΣ<sp>", "lower", Input, Expected);
FS_Total := FS_Total + 1;
-- 4e. Case_Ignorable between: A + Σ + ' + B → medial
-- Apostrophe (U+0027) is Case_Ignorable (WBP=Single_Quote)
Input := (Data => [others => 0], Len => 0);
Encode_CP (16#0041#, Input);
Encode_CP (16#03A3#, Input);
Encode_CP (16#0027#, Input); -- apostrophe
Encode_CP (16#0042#, Input);
Expected := (Data => [others => 0], Len => 0);
Encode_CP (16#0061#, Expected);
Encode_CP (16#03C3#, Expected); -- σ medial (cased follows through CI)
Encode_CP (16#0027#, Expected);
Encode_CP (16#0062#, Expected);
Check_Mapping ("FS medial AΣ'B", "lower", Input, Expected);
FS_Total := FS_Total + 1;
-- 4f. Case_Ignorable between, no following cased: A + Σ + ' → final
Input := (Data => [others => 0], Len => 0);
Encode_CP (16#0041#, Input);
Encode_CP (16#03A3#, Input);
Encode_CP (16#0027#, Input);
Expected := (Data => [others => 0], Len => 0);
Encode_CP (16#0061#, Expected);
Encode_CP (16#03C2#, Expected); -- ς final
Encode_CP (16#0027#, Expected);
Check_Mapping ("FS final AΣ'", "lower", Input, Expected);
FS_Total := FS_Total + 1;
-- 4g. No preceding cased, followed by non-cased: " Σ " → " σ "
Input := (Data => [others => 0], Len => 0);
Encode_CP (16#0020#, Input);
Encode_CP (16#03A3#, Input);
Encode_CP (16#0020#, Input);
Expected := (Data => [others => 0], Len => 0);
Encode_CP (16#0020#, Expected);
Encode_CP (16#03C3#, Expected); -- σ medial (no preceding cased)
Encode_CP (16#0020#, Expected);
Check_Mapping ("FS medial <sp>Σ<sp>", "lower", Input, Expected);
FS_Total := FS_Total + 1;
Put_Line (Natural'Image (FS_Total) & " tests");
end Test_Final_Sigma;
begin
-- Initialize properties (required by case mapping)
Properties.Initialize ("ucd", Init_OK);
if not Init_OK then
Put_Line ("ERROR: Properties.Initialize failed");
return;
end if;
-- Initialize case mapping
Case_Mapping.Initialize ("ucd", Init_OK);
if not Init_OK then
Put_Line ("ERROR: Case_Mapping.Initialize failed");
return;
end if;
Put_Line ("Case mapping conformance tests");
Put_Line ("==============================");
New_Line;
-- Load SpecialCasing overrides first (for UnicodeData test)
Load_SC_Overrides;
-- Run all test suites
Test_SpecialCasing;
Test_CaseFolding;
Test_UnicodeData;
Test_Final_Sigma;
-- Summary
New_Line;
Put_Line ("Total:" & Natural'Image (Passed) & "/" &
Natural'Image (Total) & " passed,"
& Natural'Image (Failed) & " failed");
if Failed > 0 then
Put_Line ("SOME TESTS FAILED");
else
Put_Line ("All tests passed.");
end if;
end Test_Case_Mapping;