--  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 — Word break conformance test
--
--  Parses WordBreakTest.txt and runs each test case through
--  Next_Word_Break.  Compares break positions against
--  expected breaks from the test file.
-------------------------------------------------------------------------------

with Ada.Text_IO;
with Lingenic_Text.Properties;
with Lingenic_Text.Words;
with Lingenic_Text.UTF8;

procedure Test_Words is

   use Ada.Text_IO;
   use Lingenic_Text;

   Success : Boolean;
   Total   : Natural := 0;
   Passed  : Natural := 0;
   Failed  : Natural := 0;

   Max_CPs : constant := 64;

   type CP_Array is array (1 .. Max_CPs) of Codepoint;

   --  Parsed test case: codepoints and expected break positions.
   --  Breaks(I) = True means there's a break BEFORE codepoint I.
   --  Breaks(Num_CPs + 1) = True means break after last codepoint.
   type Break_Array is array (1 .. Max_CPs + 1) of Boolean;

   ---------------------------------------------------------------------------
   --  Parse a hex string to a codepoint value
   ---------------------------------------------------------------------------
   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;

   ---------------------------------------------------------------------------
   --  Parse a test line.  Format:
   --  ÷ 000D × 000A ÷    # comment
   --
   --  ÷ = break, × = no-break.  Hex values are codepoints.
   --  Returns the number of codepoints parsed, or 0 on failure.
   ---------------------------------------------------------------------------
   procedure Parse_Line
     (Line    : String;
      CPs     : out CP_Array;
      Breaks  : out Break_Array;
      Num_CPs : out Natural)
   is
      Pos     : Natural := Line'First;
      CP_Idx  : Natural := 0;
      In_Hex  : Boolean := False;
      Hex_Start : Natural := 0;
   begin
      CPs := [others => 0];
      Breaks := [others => False];
      Num_CPs := 0;

      --  Skip to first non-space
      while Pos <= Line'Last and then Line (Pos) = ' ' loop
         Pos := Pos + 1;
      end loop;

      while Pos <= Line'Last loop
         --  Check for comment marker
         if Line (Pos) = '#' then
            exit;
         end if;

         --  Check for ÷ (U+00F7, UTF-8: C3 B7)
         if Pos + 1 <= Line'Last
           and then Character'Pos (Line (Pos)) = 16#C3#
           and then Character'Pos (Line (Pos + 1)) = 16#B7#
         then
            --  Break marker before next codepoint
            Breaks (CP_Idx + 1) := True;
            Pos := Pos + 2;

         --  Check for × (U+00D7, UTF-8: C3 97)
         elsif Pos + 1 <= Line'Last
           and then Character'Pos (Line (Pos)) = 16#C3#
           and then Character'Pos (Line (Pos + 1)) = 16#97#
         then
            --  No-break marker
            Breaks (CP_Idx + 1) := False;
            Pos := Pos + 2;

         --  Hex digit
         elsif Line (Pos) in '0' .. '9' | 'A' .. 'F' | 'a' .. 'f' then
            if not In_Hex then
               In_Hex := True;
               Hex_Start := Pos;
            end if;
            Pos := Pos + 1;

         --  Space (or other) — may end a hex token
         else
            if In_Hex then
               CP_Idx := CP_Idx + 1;
               if CP_Idx > Max_CPs then
                  Num_CPs := 0;
                  return;
               end if;
               CPs (CP_Idx) := Hex_To_CP (Line (Hex_Start .. Pos - 1));
               In_Hex := False;
            end if;
            Pos := Pos + 1;
         end if;
      end loop;

      --  Flush last hex token if any
      if In_Hex and CP_Idx < Max_CPs then
         CP_Idx := CP_Idx + 1;
         CPs (CP_Idx) := Hex_To_CP (Line (Hex_Start .. Line'Last));
      end if;

      Num_CPs := CP_Idx;
   end Parse_Line;

   ---------------------------------------------------------------------------
   --  Encode codepoints to UTF-8 byte array
   ---------------------------------------------------------------------------
   Max_Bytes : constant := Max_CPs * 4;

   procedure Encode_CPs
     (CPs     : CP_Array;
      Num_CPs : Natural;
      Buf     : out Byte_Array;
      Buf_Len : out Natural)
   is
      Pos : Positive := 1;
      Len : Positive;
   begin
      Buf := [others => 0];
      Buf_Len := 0;

      for I in 1 .. Num_CPs loop
         if Is_Scalar_Value (CPs (I))
           and then Pos + 3 <= Buf'Last
         then
            UTF8.Encode (CPs (I), Buf, Pos, Len);
            Pos := Pos + Len;
         end if;
      end loop;

      Buf_Len := Pos - 1;
   end Encode_CPs;

   ---------------------------------------------------------------------------
   --  Compute expected break byte positions from codepoint-level breaks
   ---------------------------------------------------------------------------
   type Position_Array is array (1 .. Max_CPs + 1) of Natural;

   procedure Compute_Expected_Breaks
     (CPs            : CP_Array;
      Num_CPs        : Natural;
      Breaks         : Break_Array;
      Expected       : out Position_Array;
      Num_Expected   : out Natural)
   is
      Byte_Pos : Positive := 1;
   begin
      Expected := [others => 0];
      Num_Expected := 0;

      for I in 1 .. Num_CPs loop
         if Breaks (I) then
            Num_Expected := Num_Expected + 1;
            Expected (Num_Expected) := Byte_Pos;
         end if;
         --  Advance past this codepoint's UTF-8 bytes
         if CPs (I) <= 16#7F# then
            Byte_Pos := Byte_Pos + 1;
         elsif CPs (I) <= 16#7FF# then
            Byte_Pos := Byte_Pos + 2;
         elsif CPs (I) <= 16#FFFF# then
            Byte_Pos := Byte_Pos + 3;
         else
            Byte_Pos := Byte_Pos + 4;
         end if;
      end loop;

      --  Break after last codepoint (always, WB2)
      if Breaks (Num_CPs + 1) then
         Num_Expected := Num_Expected + 1;
         Expected (Num_Expected) := Byte_Pos;
      end if;
   end Compute_Expected_Breaks;

   ---------------------------------------------------------------------------
   --  Run one test case
   ---------------------------------------------------------------------------
   procedure Run_Test
     (Line_Num : Positive;
      Line     : String)
   is
      CPs      : CP_Array;
      Brks     : Break_Array;
      Num_CPs  : Natural;
      Buf      : Byte_Array (1 .. Max_Bytes) := [others => 0];
      Buf_Len  : Natural;
      Expected : Position_Array;
      Num_Exp  : Natural;
      Got      : Position_Array;
      Num_Got  : Natural := 0;
      Pos      : Positive;
      Next_Pos : Positive;
   begin
      Parse_Line (Line, CPs, Brks, Num_CPs);
      if Num_CPs = 0 then
         return;
      end if;

      Encode_CPs (CPs, Num_CPs, Buf, Buf_Len);
      if Buf_Len = 0 then
         return;
      end if;

      Compute_Expected_Breaks (CPs, Num_CPs, Brks, Expected, Num_Exp);

      --  Run word break segmentation on the encoded text.
      Num_Got := 1;
      Got := [others => 0];
      Got (1) := 1;  --  WB1: break at start
      Pos := 1;

      while Pos <= Buf_Len loop
         Words.Next_Word_Break (Buf (1 .. Buf_Len), Pos, Next_Pos);
         Num_Got := Num_Got + 1;
         if Num_Got <= Got'Last then
            Got (Num_Got) := Next_Pos;
         end if;
         exit when Next_Pos > Buf_Len;
         Pos := Next_Pos;
      end loop;

      Total := Total + 1;

      --  Compare
      if Num_Got /= Num_Exp then
         Put_Line ("FAIL line" & Positive'Image (Line_Num) &
                   ": expected" & Natural'Image (Num_Exp) &
                   " breaks, got" & Natural'Image (Num_Got));
         Put ("  Expected:");
         for I in 1 .. Num_Exp loop
            Put (Natural'Image (Expected (I)));
         end loop;
         New_Line;
         Put ("  Got:     ");
         for I in 1 .. Num_Got loop
            Put (Natural'Image (Got (I)));
         end loop;
         New_Line;
         Put_Line ("  Line: " & Line (Line'First ..
           Natural'Min (Line'Last, Line'First + 79)));
         Failed := Failed + 1;
      else
         declare
            Match : Boolean := True;
         begin
            for I in 1 .. Num_Exp loop
               if Expected (I) /= Got (I) then
                  Match := False;
                  exit;
               end if;
            end loop;

            if Match then
               Passed := Passed + 1;
            else
               Put_Line ("FAIL line" & Positive'Image (Line_Num) &
                         ": break positions differ");
               Put ("  Expected:");
               for I in 1 .. Num_Exp loop
                  Put (Natural'Image (Expected (I)));
               end loop;
               New_Line;
               Put ("  Got:     ");
               for I in 1 .. Num_Got loop
                  Put (Natural'Image (Got (I)));
               end loop;
               New_Line;
               Put_Line ("  Line: " & Line (Line'First ..
                 Natural'Min (Line'Last, Line'First + 79)));
               Failed := Failed + 1;
            end if;
         end;
      end if;
   end Run_Test;

   F : File_Type;

begin
   Put_Line ("=== Lingenic-Text Word Break Conformance Test ===");
   Put_Line ("");

   Properties.Initialize ("ucd", Success);

   if not Success then
      Put_Line ("FAIL: Initialize returned False");
      return;
   end if;

   Put_Line ("Initialize: OK");
   Put_Line ("");

   --  Open and parse WordBreakTest.txt
   Open (F, In_File, "ucd/WordBreakTest.txt");

   declare
      Line_Num : Positive := 1;
   begin
      while not End_Of_File (F) loop
         declare
            Line : constant String := Get_Line (F);
         begin
            --  Skip comment-only lines and blank lines
            if Line'Length > 0 and then Line (Line'First) /= '#' then
               Run_Test (Line_Num, Line);
            end if;
            Line_Num := Line_Num + 1;
         end;
      end loop;
   end;

   Close (F);

   Put_Line ("=== Results ===");
   Put_Line ("Total:" & Natural'Image (Total));
   Put_Line ("Passed:" & Natural'Image (Passed));
   Put_Line ("Failed:" & Natural'Image (Failed));
   Put_Line ("");

   if Failed = 0 then
      Put_Line ("ALL TESTS PASSED");
   else
      Put_Line ("FAILURES DETECTED");
   end if;

exception
   when Ada.Text_IO.Name_Error =>
      Put_Line ("ERROR: Cannot open ucd/WordBreakTest.txt");
end Test_Words;