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