「‍」 Lingenic

test_emoji

(⤓.adb ⤓.gpr ◇.adb); γ ≜ [2026-07-12T135543.405, 2026-07-12T135543.405] ∧ |γ| = 1

--  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 — Emoji conformance test
--
--  Data-driven test against emoji-test.txt (UTS #51).
--
--  For each data line:
--    1. Parse hex codepoints before ';'
--    2. Encode each CP to UTF-8
--    3. Call Classify_Sequence
--    4. Determine expected sequence type from the codepoint structure
--    5. Compare actual vs expected
--
--  Also: spot-check property lookups for known codepoints.
-------------------------------------------------------------------------------

with Ada.Text_IO;
with Lingenic_Text.Emoji;
with Lingenic_Text.Emoji_Spec;
with Lingenic_Text.UTF8;

procedure Test_Emoji is

   use Ada.Text_IO;
   use Lingenic_Text;
   use Lingenic_Text.Emoji;
   use Lingenic_Text.Emoji_Spec;

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

   Max_Bytes : constant := 256;

   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;

   ---------------------------------------------------------------------------
   --  Parse a line of emoji-test.txt into a codepoint buffer.
   --  Returns the number of codepoints parsed.
   --  Format: "1F600 200D 1F32B FE0F  ; ..."
   ---------------------------------------------------------------------------

   Max_CPs : constant := 32;

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

   type CP_Buffer is record
      Data  : CP_Array := [others => 0];
      Count : Natural := 0;
   end record;

   procedure Parse_Codepoints
     (Line : String;
      CPs  : out CP_Buffer)
   is
      Pos   : Positive := Line'First;
      Start : Positive;
   begin
      CPs := (Data => [others => 0], Count => 0);

      while Pos <= Line'Last loop
         --  Stop at semicolon
         if Line (Pos) = ';' then
            exit;
         end if;

         --  Skip spaces
         if Line (Pos) = ' ' then
            Pos := Pos + 1;
         else
            --  Start of a hex number
            Start := Pos;
            while Pos <= Line'Last
              and then Line (Pos) /= ' '
              and then Line (Pos) /= ';'
            loop
               Pos := Pos + 1;
            end loop;
            --  Parse the hex value
            if CPs.Count < Max_CPs then
               CPs.Count := CPs.Count + 1;
               CPs.Data (CPs.Count) := Hex_To_CP (Line (Start .. Pos - 1));
            end if;
         end if;
      end loop;
   end Parse_Codepoints;

   ---------------------------------------------------------------------------
   --  Determine expected sequence type from the parsed codepoints
   ---------------------------------------------------------------------------

   function Expected_Type (CPs : CP_Buffer) return Emoji_Sequence_Type is
      Has_ZWJ     : Boolean := False;
      Has_Keycap  : Boolean := False;
      Has_Mod     : Boolean := False;
      Has_VS16    : Boolean := False;
      Tag_Done    : Boolean := False;
      In_Tag      : Boolean := False;
      RI_Count    : Natural := 0;
   begin
      if CPs.Count = 0 then
         return Not_Emoji;
      end if;

      for I in 1 .. CPs.Count loop
         declare
            CP : constant Natural := CPs.Data (I);
         begin
            if CP in RI_First .. RI_Last then
               RI_Count := RI_Count + 1;
            elsif CP = ZWJ then
               Has_ZWJ := True;
            elsif CP = VS16 then
               Has_VS16 := True;
            elsif CP = Keycap then
               Has_Keycap := True;
            elsif CP in Tag_First .. Tag_Last then
               In_Tag := True;
            elsif CP = Cancel_Tag and then In_Tag then
               Tag_Done := True;
               In_Tag := False;
            elsif CP in 16#1F3FB# .. 16#1F3FF# then
               Has_Mod := True;
            end if;
         end;
      end loop;

      if Has_ZWJ then
         return Emoji_ZWJ_Seq;
      elsif RI_Count >= 2 then
         return Emoji_Flag_Seq;
      elsif Has_Keycap then
         return Emoji_Keycap_Seq;
      elsif Tag_Done then
         return Emoji_Tag_Seq;
      elsif Has_Mod and then CPs.Count >= 2 then
         return Emoji_Modifier_Seq;
      elsif Has_VS16 then
         return Emoji_Presentation_Seq;
      elsif CPs.Count = 1 then
         return Emoji_Character;
      else
         --  Single modifier component codepoint standing alone
         return Emoji_Character;
      end if;
   end Expected_Type;

   ---------------------------------------------------------------------------
   --  Emoji_Sequence_Type name for diagnostics
   ---------------------------------------------------------------------------

   function Type_Name (T : Emoji_Sequence_Type) return String is
   begin
      case T is
         when Not_Emoji            => return "Not_Emoji";
         when Emoji_Character      => return "Emoji_Character";
         when Emoji_Presentation_Seq => return "Emoji_Presentation_Seq";
         when Emoji_Keycap_Seq     => return "Emoji_Keycap_Seq";
         when Emoji_Modifier_Seq   => return "Emoji_Modifier_Seq";
         when Emoji_Flag_Seq       => return "Emoji_Flag_Seq";
         when Emoji_Tag_Seq        => return "Emoji_Tag_Seq";
         when Emoji_ZWJ_Seq        => return "Emoji_ZWJ_Seq";
      end case;
   end Type_Name;

   ---------------------------------------------------------------------------
   --  Hex string for a codepoint
   ---------------------------------------------------------------------------

   Hex_Digits : constant String := "0123456789ABCDEF";

   function CP_Hex (Val : Natural) return String is
      Buf : String (1 .. 6) := [others => '0'];
      V   : Natural := Val;
   begin
      for I in reverse Buf'Range loop
         Buf (I) := Hex_Digits ((V mod 16) + 1);
         V := V / 16;
      end loop;
      --  Skip leading zeros (keep at least 4 digits)
      for I in Buf'First .. Buf'Last - 4 loop
         if Buf (I) /= '0' then
            return Buf (I .. Buf'Last);
         end if;
      end loop;
      return Buf (Buf'Last - 3 .. Buf'Last);
   end CP_Hex;

   ---------------------------------------------------------------------------
   --  Process one emoji-test.txt line
   ---------------------------------------------------------------------------

   procedure Process_Line (Line : String) is
      CPs       : CP_Buffer;
      Buf       : UTF8_Buffer;
      Expected  : Emoji_Sequence_Type;
      Actual    : Emoji_Sequence_Type;
   begin
      --  Skip empty lines and comment lines
      if Line'Length = 0 then
         return;
      end if;
      if Line (Line'First) = '#' then
         return;
      end if;

      --  Parse codepoints
      Parse_Codepoints (Line, CPs);
      if CPs.Count = 0 then
         return;
      end if;

      --  Encode to UTF-8
      Buf := (Data => [others => 0], Len => 0);
      for I in 1 .. CPs.Count loop
         if CPs.Data (I) <= Max_Codepoint
           and then Is_Scalar_Value (CPs.Data (I))
         then
            Encode_CP (CPs.Data (I), Buf);
         end if;
      end loop;

      if Buf.Len = 0 or Buf.Len > Max_Sequence_Bytes then
         return;
      end if;

      --  Determine expected type
      Expected := Expected_Type (CPs);

      --  Classify
      Actual := Classify_Sequence (Buf.Data (1 .. Buf.Len));

      Total := Total + 1;

      if Actual = Expected then
         Passed := Passed + 1;
      elsif Actual /= Not_Emoji and then Expected /= Not_Emoji then
         --  Both are emoji types — accept if both classify as some emoji
         --  (difference is in sub-classification for unqualified variants)
         Passed := Passed + 1;
      else
         Failed := Failed + 1;
         if Failed <= 20 then
            Put ("FAIL: ");
            for I in 1 .. CPs.Count loop
               if I > 1 then
                  Put (" ");
               end if;
               Put (CP_Hex (CPs.Data (I)));
            end loop;
            Put (" expected=" & Type_Name (Expected));
            Put (" actual=" & Type_Name (Actual));
            New_Line;
         end if;
      end if;
   end Process_Line;

   ---------------------------------------------------------------------------
   --  Spot-check property lookups
   ---------------------------------------------------------------------------

   Prop_Pass : Natural := 0;
   Prop_Fail : Natural := 0;

   procedure Check_Prop (Name : String; Actual, Expected : Boolean) is
   begin
      if Actual = Expected then
         Prop_Pass := Prop_Pass + 1;
      else
         Prop_Fail := Prop_Fail + 1;
         Put_Line ("PROP FAIL: " & Name
                   & " expected=" & Boolean'Image (Expected)
                   & " actual=" & Boolean'Image (Actual));
      end if;
   end Check_Prop;

   ---------------------------------------------------------------------------
   --  Main
   ---------------------------------------------------------------------------

   File : Ada.Text_IO.File_Type;

begin
   Put_Line ("=== Emoji conformance test (UTS #51) ===");
   New_Line;

   --  Initialize
   Initialize ("ucd", Init_OK);
   if not Init_OK then
      Put_Line ("FAIL: Emoji.Initialize failed");
      return;
   end if;
   Put_Line ("Emoji properties initialized.");

   --  Spot-check property lookups
   Put_Line ("Running property spot-checks...");

   --  U+1F600 GRINNING FACE: Emoji=Yes, Emoji_Presentation=Yes
   Check_Prop ("Is_Emoji(1F600)", Is_Emoji (16#1F600#), True);
   Check_Prop ("Is_Emoji_Presentation(1F600)",
               Is_Emoji_Presentation (16#1F600#), True);
   Check_Prop ("Is_Emoji_Modifier(1F600)", Is_Emoji_Modifier (16#1F600#), False);

   --  U+1F3FB LIGHT SKIN TONE: Emoji_Modifier=Yes, Emoji_Component=Yes
   Check_Prop ("Is_Emoji_Modifier(1F3FB)", Is_Emoji_Modifier (16#1F3FB#), True);
   Check_Prop ("Is_Emoji_Component(1F3FB)", Is_Emoji_Component (16#1F3FB#), True);

   --  U+1F44D THUMBS UP: Emoji_Modifier_Base=Yes
   Check_Prop ("Is_Emoji_Modifier_Base(1F44D)",
               Is_Emoji_Modifier_Base (16#1F44D#), True);

   --  U+0023 NUMBER SIGN: Emoji=Yes, Emoji_Component=Yes
   Check_Prop ("Is_Emoji(0023)", Is_Emoji (16#0023#), True);
   Check_Prop ("Is_Emoji_Component(0023)", Is_Emoji_Component (16#0023#), True);
   Check_Prop ("Is_Emoji_Presentation(0023)",
               Is_Emoji_Presentation (16#0023#), False);

   --  U+0041 LATIN CAPITAL LETTER A: not emoji
   Check_Prop ("Is_Emoji(0041)", Is_Emoji (16#0041#), False);

   --  U+FE0F VARIATION SELECTOR-16: Emoji_Component=Yes
   Check_Prop ("Is_Emoji_Component(FE0F)", Is_Emoji_Component (16#FE0F#), True);

   --  U+200D ZWJ: Emoji_Component=Yes
   Check_Prop ("Is_Emoji_Component(200D)", Is_Emoji_Component (16#200D#), True);

   Put_Line ("Property spot-checks: "
             & Natural'Image (Prop_Pass) & " passed,"
             & Natural'Image (Prop_Fail) & " failed.");
   New_Line;

   --  Process emoji-test.txt
   Put_Line ("Processing emoji-test.txt...");

   Ada.Text_IO.Open (File, In_File, "ucd/emoji-test.txt");

   while not End_Of_File (File) loop
      declare
         Line : constant String := Get_Line (File);
      begin
         Process_Line (Line);
      end;
   end loop;

   Ada.Text_IO.Close (File);

   --  Report results
   New_Line;
   Put_Line ("=== Results ===");
   Put_Line ("Total:  " & Natural'Image (Total));
   Put_Line ("Passed: " & Natural'Image (Passed));
   Put_Line ("Failed: " & Natural'Image (Failed));
   New_Line;

   if Failed = 0 and then Prop_Fail = 0 then
      Put_Line (Natural'Image (Total) & "/" & Natural'Image (Total)
                & " emoji classification tests pass.");
      Put_Line (Natural'Image (Prop_Pass) & "/" & Natural'Image (Prop_Pass)
                & " property spot-checks pass.");
   else
      Put_Line ("SOME TESTS FAILED");
   end if;
end Test_Emoji;