-- 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.
--
-------------------------------------------------------------------------------
-- test_idna.adb — IDNA conformance test (IdnaTestV2.txt)
--
-- Tests To_ASCII (nontransitional) and To_Unicode against IdnaTestV2.txt.
-- All default options (CheckHyphens, CheckBidi, CheckJoiners, UseSTD3,
-- VerifyDnsLength all True).
--
-- For each test line:
-- 1. Parse source (with \uXXXX / \x{XXXX} unescape), expected results
-- 2. Call To_ASCII, check success/failure matches expected status
-- 3. Call To_Unicode, check success/failure matches expected status
-- 4. On success, compare output byte-for-byte against expected
-------------------------------------------------------------------------------
with Ada.Text_IO;
with Ada.Command_Line;
with Lingenic_Text;
with Lingenic_Text.Properties;
with Lingenic_Text.Normalization;
with Lingenic_Text.IDNA;
with Lingenic_Text.IDNA_Spec;
with Lingenic_Text.UTF8;
procedure Test_IDNA is
use Ada.Text_IO;
use Lingenic_Text;
use Lingenic_Text.IDNA_Spec;
use type IDNA.IDNA_Result;
UCD_Dir : constant String := "ucd";
Total_Tests : Natural := 0;
Passed_Tests : Natural := 0;
Failed_Tests : Natural := 0;
Skipped_Tests : Natural := 0;
Max_Failures : constant := 50;
---------------------------------------------------------------------------
-- Hex parsing
---------------------------------------------------------------------------
function Is_Hex (C : Character) return Boolean is
begin
return C in '0' .. '9' or C in 'A' .. 'F' or C in 'a' .. 'f';
end Is_Hex;
function Hex_Val (C : Character) return Natural is
begin
case C is
when '0' .. '9' => return Character'Pos (C) - Character'Pos ('0');
when 'A' .. 'F' =>
return Character'Pos (C) - Character'Pos ('A') + 10;
when 'a' .. 'f' =>
return Character'Pos (C) - Character'Pos ('a') + 10;
when others => return 0;
end case;
end Hex_Val;
---------------------------------------------------------------------------
-- Unescape a test string: handles \uXXXX and \x{XXXX} sequences.
-- Returns UTF-8 bytes.
---------------------------------------------------------------------------
procedure Unescape
(S : String;
Output : out Byte_Array;
Last : out Natural)
is
P : Positive := S'First;
CP : Codepoint;
Enc_Len : Positive;
begin
Output := [others => 0];
Last := Output'First - 1;
while P <= S'Last loop
if P + 1 <= S'Last and then S (P) = '\' then
if S (P + 1) = 'u' and then P + 5 <= S'Last then
-- \uXXXX (4 hex digits)
if Is_Hex (S (P + 2)) and then Is_Hex (S (P + 3))
and then Is_Hex (S (P + 4)) and then Is_Hex (S (P + 5))
then
CP := Hex_Val (S (P + 2)) * 4096
+ Hex_Val (S (P + 3)) * 256
+ Hex_Val (S (P + 4)) * 16
+ Hex_Val (S (P + 5));
P := P + 6;
-- Handle surrogate pairs
if CP >= 16#D800# and CP <= 16#DBFF# then
-- High surrogate: look for \uDxxx low surrogate
if P + 5 <= S'Last and then S (P) = '\'
and then S (P + 1) = 'u'
and then Is_Hex (S (P + 2)) and then Is_Hex (S (P + 3))
and then Is_Hex (S (P + 4)) and then Is_Hex (S (P + 5))
then
declare
Low_CP : constant Natural :=
Hex_Val (S (P + 2)) * 4096
+ Hex_Val (S (P + 3)) * 256
+ Hex_Val (S (P + 4)) * 16
+ Hex_Val (S (P + 5));
begin
if Low_CP >= 16#DC00# and Low_CP <= 16#DFFF# then
CP := 16#10000#
+ (CP - 16#D800#) * 16#400#
+ (Low_CP - 16#DC00#);
P := P + 6;
else
-- Isolated high surrogate: skip this test
Last := Output'First - 1;
return;
end if;
end;
else
-- Isolated surrogate
Last := Output'First - 1;
return;
end if;
elsif CP >= 16#DC00# and CP <= 16#DFFF# then
-- Isolated low surrogate: skip
Last := Output'First - 1;
return;
end if;
-- Encode CP as UTF-8
if Is_Scalar_Value (CP)
and then Last + 4 < Output'Last
then
UTF8.Encode (CP, Output, Last + 1, Enc_Len);
Last := Last + Enc_Len;
end if;
goto Continue;
end if;
elsif S (P + 1) = 'x' and then P + 3 <= S'Last
and then S (P + 2) = '{'
then
-- \x{XXXX} (variable hex digits)
declare
Start : constant Positive := P + 3;
End_P : Natural := 0;
begin
for I in Start .. S'Last loop
if S (I) = '}' then
End_P := I;
exit;
end if;
end loop;
if End_P > Start then
CP := 0;
for I in Start .. End_P - 1 loop
if Is_Hex (S (I)) then
CP := CP * 16 + Hex_Val (S (I));
end if;
end loop;
P := End_P + 1;
if CP <= Max_Codepoint and then Is_Scalar_Value (CP)
and then Last + 4 < Output'Last
then
UTF8.Encode (CP, Output, Last + 1, Enc_Len);
Last := Last + Enc_Len;
end if;
goto Continue;
end if;
end;
end if;
end if;
-- Regular character — encode as UTF-8
CP := Character'Pos (S (P));
P := P + 1;
-- Multi-byte UTF-8 in test file (the file is UTF-8)
if CP in 16#C0# .. 16#DF# and then P <= S'Last then
-- 2-byte UTF-8
CP := (CP - 16#C0#) * 64
+ (Character'Pos (S (P)) - 16#80#);
P := P + 1;
elsif CP in 16#E0# .. 16#EF#
and then P + 1 <= S'Last
then
-- 3-byte UTF-8
CP := (CP - 16#E0#) * 4096
+ (Character'Pos (S (P)) - 16#80#) * 64
+ (Character'Pos (S (P + 1)) - 16#80#);
P := P + 2;
elsif CP in 16#F0# .. 16#F7#
and then P + 2 <= S'Last
then
-- 4-byte UTF-8
CP := (CP - 16#F0#) * 262144
+ (Character'Pos (S (P)) - 16#80#) * 4096
+ (Character'Pos (S (P + 1)) - 16#80#) * 64
+ (Character'Pos (S (P + 2)) - 16#80#);
P := P + 3;
end if;
if CP <= Max_Codepoint and then Is_Scalar_Value (CP)
and then Last + 4 < Output'Last
then
UTF8.Encode (CP, Output, Last + 1, Enc_Len);
Last := Last + Enc_Len;
elsif CP < 128 then
Last := Last + 1;
Output (Last) := CP;
end if;
<<Continue>>
end loop;
end Unescape;
---------------------------------------------------------------------------
-- Parse status field: returns True if status indicates success ([] or blank)
---------------------------------------------------------------------------
function Is_Status_Success (S : String) return Boolean is
begin
-- Empty or only whitespace = success (inherits from previous column)
-- "[]" = explicit success
for I in S'Range loop
if S (I) /= ' ' and S (I) /= ASCII.HT then
-- Check for "[]"
if S (I) = '[' then
-- Find ']'
for J in I + 1 .. S'Last loop
if S (J) = ']' then
-- Check if contents between [ ] is empty or only spaces
declare
Inner : constant String := S (I + 1 .. J - 1);
Has_Content : Boolean := False;
begin
for K in Inner'Range loop
if Inner (K) /= ' ' then
Has_Content := True;
exit;
end if;
end loop;
return not Has_Content;
end;
end if;
end loop;
return False; -- '[' without matching ']' — error
else
return False; -- Non-whitespace, non-bracket content
end if;
end if;
end loop;
return True; -- All whitespace = blank field
end Is_Status_Success;
function Is_Blank (S : String) return Boolean is
begin
for I in S'Range loop
if S (I) /= ' ' and S (I) /= ASCII.HT then
return False;
end if;
end loop;
return True;
end Is_Blank;
---------------------------------------------------------------------------
-- Trim whitespace
---------------------------------------------------------------------------
function Trim (S : String) return String is
First : Positive := S'First;
Last : Natural := S'Last;
begin
while First <= Last
and then (S (First) = ' ' or S (First) = ASCII.HT)
loop
First := First + 1;
end loop;
while Last >= First
and then (S (Last) = ' ' or S (Last) = ASCII.HT)
loop
Last := Last - 1;
end loop;
if First > Last then
return "";
end if;
return S (First .. Last);
end Trim;
---------------------------------------------------------------------------
-- Process one test line
---------------------------------------------------------------------------
procedure Process_Line (Line : String) is
Max_Buf : constant := 4096;
-- Find semicolons to split 7 fields
Semi : array (1 .. 7) of Natural := [others => 0];
Cnt : Natural := 0;
Eff_Last : Natural := Line'Last;
Source_Buf : Byte_Array (1 .. Max_Buf) := [others => 0];
Source_Last : Natural;
Expected_Unicode_Buf : Byte_Array (1 .. Max_Buf) := [others => 0];
Expected_Unicode_Last : Natural;
Expected_ASCII_Buf : Byte_Array (1 .. Max_Buf) := [others => 0];
Expected_ASCII_Last : Natural;
-- Output buffers
Out_Buf : Byte_Array (1 .. Max_Buf) := [others => 0];
Out_Last : Natural;
Status : IDNA.IDNA_Result;
Unicode_Expect_Success : Boolean;
ASCII_Expect_Success : Boolean;
begin
-- Strip comment
for I in Line'Range loop
if Line (I) = '#' then
Eff_Last := I - 1;
exit;
end if;
end loop;
-- Find semicolons
for I in Line'First .. Eff_Last loop
if Line (I) = ';' then
Cnt := Cnt + 1;
if Cnt <= 7 then
Semi (Cnt) := I;
end if;
end if;
end loop;
if Cnt < 6 then
return; -- Not enough fields
end if;
-- Field 1: Source (before first semicolon)
declare
F1 : constant String := Trim (Line (Line'First .. Semi (1) - 1));
begin
if F1 = """""" then
-- Empty string test
Skipped_Tests := Skipped_Tests + 1;
return;
end if;
Unescape (F1, Source_Buf, Source_Last);
if Source_Last < Source_Buf'First then
-- Contains surrogates or other unencodable content
Skipped_Tests := Skipped_Tests + 1;
return;
end if;
end;
-- Field 2: toUnicode result (blank = same as source)
declare
F2 : constant String := Trim (Line (Semi (1) + 1 .. Semi (2) - 1));
begin
if Is_Blank (F2) then
Expected_Unicode_Buf := Source_Buf;
Expected_Unicode_Last := Source_Last;
elsif F2 = """""" then
Expected_Unicode_Last := Expected_Unicode_Buf'First - 1;
else
Unescape (F2, Expected_Unicode_Buf, Expected_Unicode_Last);
end if;
end;
-- Field 3: toUnicodeStatus
declare
F3 : constant String := Trim (Line (Semi (2) + 1 .. Semi (3) - 1));
begin
if Is_Blank (F3) then
Unicode_Expect_Success := True;
else
Unicode_Expect_Success := Is_Status_Success (F3);
end if;
end;
-- Field 4: toAsciiN result (blank = same as toUnicode)
declare
F4 : constant String := Trim (Line (Semi (3) + 1 .. Semi (4) - 1));
begin
if Is_Blank (F4) then
Expected_ASCII_Buf := Expected_Unicode_Buf;
Expected_ASCII_Last := Expected_Unicode_Last;
elsif F4 = """""" then
Expected_ASCII_Last := Expected_ASCII_Buf'First - 1;
else
Unescape (F4, Expected_ASCII_Buf, Expected_ASCII_Last);
end if;
end;
-- Field 5: toAsciiNStatus (blank = same as toUnicodeStatus)
declare
F5 : constant String := Trim (Line (Semi (4) + 1 .. Semi (5) - 1));
begin
if Is_Blank (F5) then
ASCII_Expect_Success := Unicode_Expect_Success;
else
ASCII_Expect_Success := Is_Status_Success (F5);
end if;
end;
-- Fields 6-7: toAsciiT (transitional) — we skip these
-- Test To_Unicode
Total_Tests := Total_Tests + 1;
Out_Buf := [others => 0];
IDNA.To_Unicode
(Source_Buf (Source_Buf'First .. Source_Last),
Default_Options,
Out_Buf, Out_Last, Status);
if Unicode_Expect_Success then
if Status = IDNA.Success then
-- Compare output
if Out_Last = Expected_Unicode_Last then
declare
Match : Boolean := True;
begin
for I in Out_Buf'First .. Out_Last loop
if Out_Buf (I) /= Expected_Unicode_Buf (I) then
Match := False;
exit;
end if;
end loop;
if Match then
Passed_Tests := Passed_Tests + 1;
else
Failed_Tests := Failed_Tests + 1;
if Failed_Tests <= Max_Failures then
Put_Line ("FAIL ToUnicode (mismatch): "
& Trim (Line (Line'First .. Eff_Last)));
end if;
end if;
end;
else
Failed_Tests := Failed_Tests + 1;
if Failed_Tests <= Max_Failures then
Put_Line ("FAIL ToUnicode (length): expected"
& Expected_Unicode_Last'Image
& " got" & Out_Last'Image
& " : " & Trim (Line (Line'First .. Eff_Last)));
end if;
end if;
else
Failed_Tests := Failed_Tests + 1;
if Failed_Tests <= Max_Failures then
Put_Line ("FAIL ToUnicode (unexpected error): "
& IDNA.IDNA_Result'Image (Status)
& " : " & Trim (Line (Line'First .. Eff_Last)));
end if;
end if;
else
-- Expect failure
if Status /= IDNA.Success then
Passed_Tests := Passed_Tests + 1;
else
Failed_Tests := Failed_Tests + 1;
if Failed_Tests <= Max_Failures then
Put_Line ("FAIL ToUnicode (expected error, got success): "
& Trim (Line (Line'First .. Eff_Last)));
end if;
end if;
end if;
-- Test To_ASCII (nontransitional)
Total_Tests := Total_Tests + 1;
Out_Buf := [others => 0];
IDNA.To_ASCII
(Source_Buf (Source_Buf'First .. Source_Last),
Default_Options,
Out_Buf, Out_Last, Status);
if ASCII_Expect_Success then
if Status = IDNA.Success then
if Out_Last = Expected_ASCII_Last then
declare
Match : Boolean := True;
begin
for I in Out_Buf'First .. Out_Last loop
if Out_Buf (I) /= Expected_ASCII_Buf (I) then
Match := False;
exit;
end if;
end loop;
if Match then
Passed_Tests := Passed_Tests + 1;
else
Failed_Tests := Failed_Tests + 1;
if Failed_Tests <= Max_Failures then
Put_Line ("FAIL ToASCII (mismatch): "
& Trim (Line (Line'First .. Eff_Last)));
end if;
end if;
end;
else
Failed_Tests := Failed_Tests + 1;
if Failed_Tests <= Max_Failures then
Put_Line ("FAIL ToASCII (length): expected"
& Expected_ASCII_Last'Image
& " got" & Out_Last'Image
& " : " & Trim (Line (Line'First .. Eff_Last)));
end if;
end if;
else
Failed_Tests := Failed_Tests + 1;
if Failed_Tests <= Max_Failures then
Put_Line ("FAIL ToASCII (unexpected error): "
& IDNA.IDNA_Result'Image (Status)
& " : " & Trim (Line (Line'First .. Eff_Last)));
end if;
end if;
else
if Status /= IDNA.Success then
Passed_Tests := Passed_Tests + 1;
else
Failed_Tests := Failed_Tests + 1;
if Failed_Tests <= Max_Failures then
Put_Line ("FAIL ToASCII (expected error, got success): "
& Trim (Line (Line'First .. Eff_Last)));
end if;
end if;
end if;
end Process_Line;
---------------------------------------------------------------------------
-- Main
---------------------------------------------------------------------------
OK : Boolean;
F : Ada.Text_IO.File_Type;
begin
Put_Line ("IDNA Conformance Test (UTS #46, nontransitional)");
Put_Line ("================================================");
-- Initialize subsystems
Properties.Initialize (UCD_Dir, OK);
if not OK then
Put_Line ("ERROR: Failed to initialize Properties");
Ada.Command_Line.Set_Exit_Status (1);
return;
end if;
Put_Line ("Properties initialized.");
Normalization.Initialize (UCD_Dir, OK);
if not OK then
Put_Line ("ERROR: Failed to initialize Normalization");
Ada.Command_Line.Set_Exit_Status (1);
return;
end if;
Put_Line ("Normalization initialized.");
IDNA.Initialize (UCD_Dir, OK);
if not OK then
Put_Line ("ERROR: Failed to initialize IDNA");
Ada.Command_Line.Set_Exit_Status (1);
return;
end if;
Put_Line ("IDNA initialized.");
-- Open test file
begin
Open (F, In_File, UCD_Dir & "/IdnaTestV2.txt");
exception
when others =>
Put_Line ("ERROR: Cannot open " & UCD_Dir & "/IdnaTestV2.txt");
Ada.Command_Line.Set_Exit_Status (1);
return;
end;
-- Process each line
while not End_Of_File (F) loop
declare
Line : constant String := Get_Line (F);
begin
-- Skip blank lines and comments
if Line'Length > 0 then
declare
First_Non_WS : Natural := 0;
begin
for I in Line'Range loop
if Line (I) /= ' ' and Line (I) /= ASCII.HT then
First_Non_WS := I;
exit;
end if;
end loop;
if First_Non_WS > 0 and then Line (First_Non_WS) /= '#' then
Process_Line (Line);
end if;
end;
end if;
end;
end loop;
Close (F);
-- Report results
New_Line;
Put_Line ("Results:");
Put_Line (" Total: " & Total_Tests'Image);
Put_Line (" Passed: " & Passed_Tests'Image);
Put_Line (" Failed: " & Failed_Tests'Image);
Put_Line (" Skipped: " & Skipped_Tests'Image);
if Failed_Tests > 0 then
Put_Line ("FAIL");
Ada.Command_Line.Set_Exit_Status (1);
else
Put_Line ("PASS");
end if;
end Test_IDNA;