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