--  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;