Re: Strange crash on custom iterator

[Simon Wright <simon@pushface.org>]

[-- Attachment #1: Type: text/plain, Size: 450 bytes --]

Luke A. Guest <laguest@archeia.com> writes:

> Simon Wright <> wrote:
>
>>> You don't need to make it tagged, to pass it by reference.  It is enough
>>> to make the formal parameter aliased.
>> 
>> Yes, that works (except you have to make the container you're iterating
>> over aliased too).
>
> I had to make the iterate for nation take “aliased in out” and make the
> array aliased, but it still does in the same place.

This worked for me ..


[-- Attachment #2: gnatchop-me --]
[-- Type: text/plain, Size: 9880 bytes --]

--  Copyright 2018, Luke A. Guest
--  License TBD.

with Ada.Characters.Latin_1;
with Ada.Text_IO; use Ada.Text_IO;
with UCA.Encoding;
with UCA.Iterators;

procedure Test is
   package L1 renames Ada.Characters.Latin_1;

   package Octet_IO is new Ada.Text_IO.Modular_IO (UCA.Octets);
   use Octet_IO;

   --  D  : UCA.Octets         := Character'Pos ('Q');
   --  A  : UCA.Unicode_String := UCA.To_Array (D);
   --  A2 : UCA.Unicode_String := UCA.Unicode_String'(1, 0, 0, 0, 0, 0, 1, 0);
   --  D2 : UCA.Octets         := UCA.To_Octet (A2);

   --  package OA_IO is new Ada.Text_IO.Integer_IO (Num => UCA.Bits);

   use UCA.Encoding;
   A : aliased UCA.Unicode_String :=
     +("ᚠᛇᚻ᛫ᛒᛦᚦ᛫ᚠᚱᚩᚠᚢᚱ᛫ᚠᛁᚱᚪ᛫ᚷᛖᚻᚹᛦᛚᚳᚢᛗ" & L1.LF &
         "Hello, world" & L1.LF &
         "Sîne klâwen durh die wolken sint geslagen," & L1.LF &
         "Τη γλώσσα μου έδωσαν ελληνική" & L1.LF &
         "मैं काँच खा सकता हूँ और मुझे उससे कोई चोट नहीं पहुंचती." & L1.LF &
         "میں کانچ کھا سکتا ہوں اور مجھے تکلیف نہیں ہوتی");
   B : aliased UCA.Unicode_String :=
     (225, 154, 160, 225, 155, 135, 225, 154, 187, 225, 155, 171, 225, 155, 146, 225, 155, 166, 225,
      154, 166, 225, 155, 171, 225, 154, 160, 225, 154, 177, 225, 154, 169, 225, 154, 160, 225, 154,
      162, 225, 154, 177, 225, 155, 171, 225, 154, 160, 225, 155, 129, 225, 154, 177, 225, 154, 170,
      225, 155, 171, 225, 154, 183, 225, 155, 150, 225, 154, 187, 225, 154, 185, 225, 155, 166, 225,
      155, 154, 225, 154, 179, 225, 154, 162, 225, 155, 151,
      10,
      72, 101, 108, 108, 111, 44, 32, 119, 111, 114, 108, 100,
      10,
      83, 195, 174, 110, 101, 32, 107, 108, 195, 162, 119, 101, 110, 32, 100, 117, 114, 104, 32, 100,
      105, 101, 32, 119, 111, 108, 107, 101, 110, 32, 115, 105, 110, 116, 32, 103, 101, 115, 108, 97,
      103, 101, 110, 44,
      10,
      206, 164, 206, 183, 32, 206, 179, 206, 187, 207, 142, 207, 131, 207, 131, 206, 177, 32, 206, 188,
      206, 191, 207, 133, 32, 206, 173, 206, 180, 207, 137, 207, 131, 206, 177, 206, 189, 32, 206, 181,
      206, 187, 206, 187, 206, 183, 206, 189, 206, 185, 206, 186, 206, 174,
      10,
      224, 164, 174, 224, 165, 136, 224, 164, 130, 32, 224, 164, 149, 224, 164, 190, 224, 164, 129, 224,
      164, 154, 32, 224, 164, 150, 224, 164, 190, 32, 224, 164, 184, 224, 164, 149, 224, 164, 164, 224,
      164, 190, 32, 224, 164, 185, 224, 165, 130, 224, 164, 129, 32, 224, 164, 148, 224, 164, 176, 32,
      224, 164, 174, 224, 165, 129, 224, 164, 157, 224, 165, 135, 32, 224, 164, 137, 224, 164, 184, 224,
      164, 184, 224, 165, 135, 32, 224, 164, 149, 224, 165, 139, 224, 164, 136, 32, 224, 164, 154, 224,
      165, 139, 224, 164, 159, 32, 224, 164, 168, 224, 164, 185, 224, 165, 128, 224, 164, 130, 32, 224,
      164, 170, 224, 164, 185, 224, 165, 129, 224, 164, 130, 224, 164, 154, 224, 164, 164, 224, 165, 128, 46,
      10,
      217, 133, 219, 140, 218, 186, 32, 218, 169, 216, 167, 217, 134, 218, 134, 32, 218, 169, 218, 190,
      216, 167, 32, 216, 179, 218, 169, 216, 170, 216, 167, 32, 219, 129, 217, 136, 218, 186, 32, 216,
      167, 217, 136, 216, 177, 32, 217, 133, 216, 172, 218, 190, 219, 146, 32, 216, 170, 218, 169, 217,
      132, 219, 140, 217, 129, 32, 217, 134, 219, 129, 219, 140, 218, 186, 32, 219, 129, 217, 136, 216,
      170, 219, 140);
begin
--   Put_Line ("A => " & To_UTF_8_String (A));
   Put_Line ("A => " & L1.LF & String (+A));

   Put_Line ("A => ");
   Put ('(');

   for E of A loop
      Put (Item => E, Base => 2);
      Put (", ");
   end loop;

   Put (')');
   New_Line;

   Put_Line ("B => " & L1.LF & String (+B));

   Put_Line ("A (Iterated) => ");

   for I in UCA.Iterators.Iterate (A) loop
      Put (UCA.Iterators.Element (I));       --  ERROR! Dies in Element, Data has nothing gdb => p position - $1 = (data => (), index => 1)
   end loop;

   New_Line;
end Test;

with Ada.Strings.UTF_Encoding;
with Ada.Unchecked_Conversion;

package UCA is
   use Ada.Strings.UTF_Encoding;

   type Octets is mod 2 ** 8 with
     Size => 8;

   type Unicode_String is array (Positive range <>) of Octets with
     Pack => True;

   type Unicode_String_Access is access all Unicode_String;

   --  This should match Wide_Wide_Character in size.
   type Code_Points is mod 2 ** 32 with
     Static_Predicate => Code_Points in 0 .. 16#0000_D7FF# or Code_Points in 16#0000_E000# .. 16#0010_FFFF#,
     Size             => 32;

private
   type Bits is range 0 .. 1 with
     Size => 1;

   type Bit_Range is range 0 .. Octets'Size - 1;
end UCA;

with Ada.Finalization;
with Ada.Iterator_Interfaces;
private with System.Address_To_Access_Conversions;

package UCA.Iterators is
   ---------------------------------------------------------------------------------------------------------------------
   --  Iteration over code points.
   ---------------------------------------------------------------------------------------------------------------------
   type Cursor is private;
   pragma Preelaborable_Initialization (Cursor);

   function Has_Element (Position : in Cursor) return Boolean;

   function Element (Position : in Cursor) return Octets;

   package Code_Point_Iterators is new Ada.Iterator_Interfaces (Cursor, Has_Element);

   function Iterate (Container : aliased in Unicode_String) return Code_Point_Iterators.Forward_Iterator'Class;
   function Iterate (Container : aliased in Unicode_String; Start : in Cursor) return
     Code_Point_Iterators.Forward_Iterator'Class;

   ---------------------------------------------------------------------------------------------------------------------
   --  Iteration over grapheme clusters.
   ---------------------------------------------------------------------------------------------------------------------
private
   use Ada.Finalization;

   package Convert is new System.Address_To_Access_Conversions (Unicode_String);

   type Cursor is
      record
         Data  : Convert.Object_Pointer := null;
         Index : Positive               := Positive'Last;
      end record;

   type Code_Point_Iterator is new Limited_Controlled and Code_Point_Iterators.Forward_Iterator with
      record
         Data  : Convert.Object_Pointer := null;
      end record;

   overriding
   function First (Object : in Code_Point_Iterator) return Cursor;

   overriding
   function Next  (Object : in Code_Point_Iterator; Position : Cursor) return Cursor;

end UCA.Iterators;

with Ada.Text_IO; use Ada.Text_IO;

package body UCA.Iterators is
   package Octet_IO is new Ada.Text_IO.Modular_IO (UCA.Octets);
   use Octet_IO;

   use type Convert.Object_Pointer;

   function Has_Element (Position : in Cursor) return Boolean is
   begin
      return Position.Index in Position.Data'Range;
   end Has_Element;

   function Element (Position : in Cursor) return Octets is
   begin
      if Position.Data = null then
         raise Constraint_Error with "Fuck!";
      end if;
      Put ("<< Element - " & Positive'Image (Position.Index) & " - ");
      Put (Position.Data (Position.Index));
      Put_Line (" >>");

      return Position.Data (Position.Index);
   end Element;

   function Iterate (Container : aliased in Unicode_String) return Code_Point_Iterators.Forward_Iterator'Class is
   begin
      Put_Line ("<< iterate >>");
      return I : Code_Point_Iterator := (Limited_Controlled with
        Data => Convert.To_Pointer (Container'Address)) do
         if I.Data = null then
            Put_Line ("Data => null");
         else
            Put_Line ("Data => not null - Length: " & Positive'Image (I.Data'Length));
         end if;
         null;
      end return;
   end Iterate;

   function Iterate (Container : aliased in Unicode_String; Start : in Cursor) return
     Code_Point_Iterators.Forward_Iterator'Class is
   begin
      Put_Line ("<< iterate >>");
      return I : Code_Point_Iterator := (Limited_Controlled with
        Data => Convert.To_Pointer (Container'Address)) do
         if I.Data = null then
            Put_Line ("Data => null");
         else
            Put_Line ("Data => not null");
         end if;
         null;
      end return;
   end Iterate;

   ---------------------------------------------------------------------------------------------------------------------
   --  Iteration over grapheme clusters.
   ---------------------------------------------------------------------------------------------------------------------
   overriding
   function First (Object : in Code_Point_Iterator) return Cursor is
   begin
      return (Data => Object.Data, Index => Positive'First);
   end First;

   overriding
   function Next  (Object : in Code_Point_Iterator; Position : Cursor) return Cursor is
   begin
      return (Data => Object.Data, Index => Position.Index + 1);
   end Next;
end UCA.Iterators;

--  Copyright © 2018, Luke A. Guest
with Ada.Unchecked_Conversion;

package body UCA.Encoding is
   function To_Unicode_String (Str : in String) return Unicode_String is
      Result : Unicode_String (1 .. Str'Length) with
        Address => Str'Address;
   begin
      return Result;
   end To_Unicode_String;

   function To_String (Str : in Unicode_String) return String is
      Result : String (1 .. Str'Length) with
        Address => Str'Address;
   begin
      return Result;
   end To_String;
end UCA.Encoding;

package UCA.Encoding is
   use Ada.Strings.UTF_Encoding;

   function To_Unicode_String (Str : in String) return Unicode_String;
   function To_String (Str : in Unicode_String) return String;

   function "+" (Str : in String) return Unicode_String renames To_Unicode_String;
   function "+" (Str : in Unicode_String) return String renames To_String;
end UCA.Encoding;