-----------------------------------------------------------------------
--  asf-components-widgets-inputs -- Input widget components
--  Copyright (C) 2013 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Strings.Unbounded;
with Ada.Characters.Conversions;

with ASF.Models.Selects;
with ASF.Components.Base;
with ASF.Components.Utils;
with ASF.Components.Html.Messages;
with ASF.Events.Faces.Actions;
with ASF.Applications.Messages.Vectors;

with Util.Strings.Transforms;
with Util.Beans.Objects;
package body ASF.Components.Widgets.Inputs is

   --  ------------------------------
   --  Render the input field title.
   --  ------------------------------
   procedure Render_Title (UI      : in UIInput;
                           Name    : in String;
                           Writer  : in Response_Writer_Access;
                           Context : in out Faces_Context'Class) is
      Title : constant Util.Beans.Objects.Object := UI.Get_Attribute (Context, "title");
   begin
      Writer.Start_Element ("dt");
      Writer.Start_Element ("label");
      Writer.Write_Attribute ("for", Name);
      Writer.Write_Text (Title);
      Writer.End_Element ("label");
      Writer.End_Element ("dt");
   end Render_Title;

   --  ------------------------------
   --  Render the input component.  Starts the DL/DD list and write the input
   --  component with the possible associated error message.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIInput;
                           Context : in out Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      declare
         Id       : constant String := To_String (UI.Get_Client_Id);
         Writer   : constant Response_Writer_Access := Context.Get_Response_Writer;
         Messages : constant ASF.Applications.Messages.Vectors.Cursor := Context.Get_Messages (Id);
         Style    : constant String := UI.Get_Attribute ("styleClass", Context);
      begin
         Writer.Start_Element ("dl");
         Writer.Write_Attribute ("id", Id);
         if ASF.Applications.Messages.Vectors.Has_Element (Messages) then
            Writer.Write_Attribute ("class", Style & " asf-error");
         elsif Style'Length > 0 then
            Writer.Write_Attribute ("class", Style);
         end if;
         UI.Render_Title (Id, Writer, Context);
         Writer.Start_Element ("dd");
         UI.Render_Input (Context, Write_Id => False);
      end;
   end Encode_Begin;

   --  ------------------------------
   --  Render the end of the input component.  Closes the DL/DD list.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UIInput;
                         Context : in out Faces_Context'Class) is
      use ASF.Components.Html.Messages;
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;

      --  Render the error message associated with the input field.
      declare
         Id       : constant String := To_String (UI.Get_Client_Id);
         Writer   : constant Response_Writer_Access := Context.Get_Response_Writer;
         Messages : constant ASF.Applications.Messages.Vectors.Cursor := Context.Get_Messages (Id);
      begin
         if ASF.Applications.Messages.Vectors.Has_Element (Messages) then
            Write_Message (UI, ASF.Applications.Messages.Vectors.Element (Messages),
                           SPAN_NO_STYLE, False, True, Context);
         end if;
         Writer.End_Element ("dd");
         Writer.End_Element ("dl");
      end;
   end Encode_End;

   --  ------------------------------
   --  Render the end of the input component.  Closes the DL/DD list.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UIComplete;
                         Context : in out Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;

      --  Render the autocomplete script and finish the input component.
      declare
         Id       : constant String := To_String (UI.Get_Client_Id);
         Writer   : constant Response_Writer_Access := Context.Get_Response_Writer;
      begin
         Writer.Queue_Script ("$('#");
         Writer.Queue_Script (Id);
         Writer.Queue_Script (" input').complete({");
         Writer.Queue_Script ("});");
         UIInput (UI).Encode_End (Context);
      end;
   end Encode_End;

   overriding
   procedure Process_Decodes (UI      : in out UIComplete;
                              Context : in out Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      declare
         Id  : constant String := To_String (UI.Get_Client_Id);
         Val : constant String := Context.Get_Parameter (Id & ".match");
      begin
         if Val'Length > 0 then
            UI.Match_Value := Util.Beans.Objects.To_Object (Val);
         else
            ASF.Components.Html.Forms.UIInput (UI).Process_Decodes (Context);
         end if;
      end;
   end Process_Decodes;

   procedure Render_List (UI      : in UIComplete;
                          Match   : in String;
                          Context : in out Faces_Context'Class) is
      use type Util.Beans.Basic.List_Bean_Access;

      List       : constant Util.Beans.Basic.List_Bean_Access
        := ASF.Components.Utils.Get_List_Bean (UI, "autocomplete", Context);
      Writer     : constant Response_Writer_Access := Context.Get_Response_Writer;
      Need_Comma : Boolean := False;
      Count      : Natural;

      procedure Render_Item (Label : in String) is
         Result : Ada.Strings.Unbounded.Unbounded_String;
      begin
         if Match'Length = 0 or else
           (Match'Length <= Label'Length
            and then Match = Label (Label'First .. Label'First + Match'Length - 1)) then
            if Need_Comma then
               Writer.Write (",");
            end if;
            Writer.Write ('"');
            Util.Strings.Transforms.Escape_Java (Content => Label,
                                                 Into    => Result);
            Writer.Write (Result);
            Writer.Write ('"');
            Need_Comma := True;
         end if;
      end Render_Item;

   begin
      Writer.Write ('[');
      if List /= null then
         Count := List.Get_Count;
         if List.all in ASF.Models.Selects.Select_Item_List'Class then
            declare
               S : access ASF.Models.Selects.Select_Item_List'Class
                 := ASF.Models.Selects.Select_Item_List'Class (List.all)'Access;
            begin
               for I in 1 .. Count loop
                  Render_Item (Ada.Characters.Conversions.To_String (S.Get_Select_Item (I).Get_Label));
               end loop;
            end;
         else
            for I in 1 .. Count loop
               List.Set_Row_Index (I);
               declare
                  Value : constant Util.Beans.Objects.Object := List.Get_Row;
                  Label : constant String := Util.Beans.Objects.To_String (Value);
               begin
                  Render_Item (Label);
               end;
            end loop;
         end if;
      end if;
      Writer.Write (']');
   end Render_List;

   overriding
   procedure Process_Updates (UI      : in out UIComplete;
                              Context : in out Faces_Context'Class) is
   begin
      if not Util.Beans.Objects.Is_Empty (UI.Match_Value) then
         declare
            Value : constant access ASF.Views.Nodes.Tag_Attribute := UI.Get_Attribute ("match");
            ME    : EL.Expressions.Method_Expression;
         begin
            if Value /= null then
               declare
                  VE    : constant EL.Expressions.Value_Expression
                    := ASF.Views.Nodes.Get_Value_Expression (Value.all);
               begin
                  VE.Set_Value (Value => UI.Match_Value, Context => Context.Get_ELContext.all);
               end;
            end if;

            --  Post an event on this component to trigger the rendering of the completion
            --  list as part of an application/json output.  The rendering is made by Broadcast.
            ASF.Events.Faces.Actions.Post_Event (UI     => UI,
                                                 Method => ME);
         end;
      else
         ASF.Components.Html.Forms.UIInput (UI).Process_Updates (Context);
      end if;

--     exception
--        when E : others =>
--           UI.Is_Valid := False;
--           UI.Add_Message (CONVERTER_MESSAGE_NAME, "convert", Context);
--           Log.Info (Utils.Get_Line_Info (UI)
--                     & ": Exception raised when updating value {0} for component {1}: {2}",
--                     EL.Objects.To_String (UI.Submitted_Value),
--                     To_String (UI.Get_Client_Id), Ada.Exceptions.Exception_Name (E));
   end Process_Updates;

   --  ------------------------------
   --  Broadcast the event to the event listeners installed on this component.
   --  Listeners are called in the order in which they were added.
   --  ------------------------------
   overriding
   procedure Broadcast (UI      : in out UIComplete;
                        Event   : not null access ASF.Events.Faces.Faces_Event'Class;
                        Context : in out Faces_Context'Class) is
      pragma Unreferenced (Event);

      Match  : constant String := Util.Beans.Objects.To_String (UI.Match_Value);
   begin
      Context.Get_Response.Set_Content_Type ("application/json; charset=UTF-8");
      UI.Render_List (Match, Context);
      Context.Response_Completed;
   end Broadcast;

end ASF.Components.Widgets.Inputs;

-----------------------------------------------------------------------
--  asf-components-widgets-inputs -- Input widget components
--  Copyright (C) 2013 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Strings.Unbounded;
with Ada.Characters.Conversions;

with ASF.Models.Selects;
with ASF.Components.Base;
with ASF.Components.Utils;
with ASF.Components.Html.Messages;
with ASF.Events.Faces.Actions;
with ASF.Applications.Messages.Vectors;

with Util.Strings.Transforms;
with Util.Beans.Objects;
package body ASF.Components.Widgets.Inputs is

   --  ------------------------------
   --  Render the input field title.
   --  ------------------------------
   procedure Render_Title (UI      : in UIInput;
                           Name    : in String;
                           Writer  : in Response_Writer_Access;
                           Context : in out Faces_Context'Class) is
      Title : constant Util.Beans.Objects.Object := UI.Get_Attribute (Context, "title");
   begin
      Writer.Start_Element ("dt");
      Writer.Start_Element ("label");
      Writer.Write_Attribute ("for", Name);
      Writer.Write_Text (Title);
      Writer.End_Element ("label");
      Writer.End_Element ("dt");
   end Render_Title;

   --  ------------------------------
   --  Render the input component.  Starts the DL/DD list and write the input
   --  component with the possible associated error message.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIInput;
                           Context : in out Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      declare
         Id       : constant String := To_String (UI.Get_Client_Id);
         Writer   : constant Response_Writer_Access := Context.Get_Response_Writer;
         Messages : constant ASF.Applications.Messages.Vectors.Cursor := Context.Get_Messages (Id);
         Style    : constant String := UI.Get_Attribute ("styleClass", Context);
      begin
         Writer.Start_Element ("dl");
         Writer.Write_Attribute ("id", Id);
         if ASF.Applications.Messages.Vectors.Has_Element (Messages) then
            Writer.Write_Attribute ("class", Style & " asf-error");
         elsif Style'Length > 0 then
            Writer.Write_Attribute ("class", Style);
         end if;
         UI.Render_Title (Id, Writer, Context);
         Writer.Start_Element ("dd");
         UI.Render_Input (Context, Write_Id => False);
      end;
   end Encode_Begin;

   --  ------------------------------
   --  Render the end of the input component.  Closes the DL/DD list.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UIInput;
                         Context : in out Faces_Context'Class) is
      use ASF.Components.Html.Messages;
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;

      --  Render the error message associated with the input field.
      declare
         Id       : constant String := To_String (UI.Get_Client_Id);
         Writer   : constant Response_Writer_Access := Context.Get_Response_Writer;
         Messages : constant ASF.Applications.Messages.Vectors.Cursor := Context.Get_Messages (Id);
      begin
         if ASF.Applications.Messages.Vectors.Has_Element (Messages) then
            Write_Message (UI, ASF.Applications.Messages.Vectors.Element (Messages),
                           SPAN_NO_STYLE, False, True, Context);
         end if;
         Writer.End_Element ("dd");
         Writer.End_Element ("dl");
      end;
   end Encode_End;

   --  ------------------------------
   --  Render the end of the input component.  Closes the DL/DD list.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UIComplete;
                         Context : in out Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;

      --  Render the autocomplete script and finish the input component.
      declare
         Id       : constant String := To_String (UI.Get_Client_Id);
         Writer   : constant Response_Writer_Access := Context.Get_Response_Writer;
      begin
         Writer.Queue_Script ("$('#");
         Writer.Queue_Script (Id);
         Writer.Queue_Script (" input').complete({");
         Writer.Queue_Script ("});");
         UIInput (UI).Encode_End (Context);
      end;
   end Encode_End;

   overriding
   procedure Process_Decodes (UI      : in out UIComplete;
                              Context : in out Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      declare
         Id  : constant String := To_String (UI.Get_Client_Id);
         Val : constant String := Context.Get_Parameter (Id & ".match");
      begin
         if Val'Length > 0 then
            UI.Match_Value := Util.Beans.Objects.To_Object (Val);
         else
            ASF.Components.Html.Forms.UIInput (UI).Process_Decodes (Context);
         end if;
      end;
   end Process_Decodes;

   procedure Render_List (UI      : in UIComplete;
                          Match   : in String;
                          Context : in out Faces_Context'Class) is
      use type Util.Beans.Basic.List_Bean_Access;

      List       : constant Util.Beans.Basic.List_Bean_Access
        := ASF.Components.Utils.Get_List_Bean (UI, "autocompleteList", Context);
      Writer     : constant Response_Writer_Access := Context.Get_Response_Writer;
      Need_Comma : Boolean := False;
      Count      : Natural;

      procedure Render_Item (Label : in String) is
         Result : Ada.Strings.Unbounded.Unbounded_String;
      begin
         if Match'Length = 0 or else
           (Match'Length <= Label'Length
            and then Match = Label (Label'First .. Label'First + Match'Length - 1)) then
            if Need_Comma then
               Writer.Write (",");
            end if;
            Writer.Write ('"');
            Util.Strings.Transforms.Escape_Java (Content => Label,
                                                 Into    => Result);
            Writer.Write (Result);
            Writer.Write ('"');
            Need_Comma := True;
         end if;
      end Render_Item;

   begin
      Writer.Write ('[');
      if List /= null then
         Count := List.Get_Count;
         if List.all in ASF.Models.Selects.Select_Item_List'Class then
            declare
               S : constant access ASF.Models.Selects.Select_Item_List'Class
                 := ASF.Models.Selects.Select_Item_List'Class (List.all)'Access;
            begin
               for I in 1 .. Count loop
                  Render_Item (Ada.Characters.Conversions.To_String (S.Get_Select_Item (I).Get_Label));
               end loop;
            end;
         else
            for I in 1 .. Count loop
               List.Set_Row_Index (I);
               declare
                  Value : constant Util.Beans.Objects.Object := List.Get_Row;
                  Label : constant String := Util.Beans.Objects.To_String (Value);
               begin
                  Render_Item (Label);
               end;
            end loop;
         end if;
      end if;
      Writer.Write (']');
   end Render_List;

   overriding
   procedure Process_Updates (UI      : in out UIComplete;
                              Context : in out Faces_Context'Class) is
   begin
      if not Util.Beans.Objects.Is_Empty (UI.Match_Value) then
         declare
            Value : constant access ASF.Views.Nodes.Tag_Attribute := UI.Get_Attribute ("match");
            ME    : EL.Expressions.Method_Expression;
         begin
            if Value /= null then
               declare
                  VE    : constant EL.Expressions.Value_Expression
                    := ASF.Views.Nodes.Get_Value_Expression (Value.all);
               begin
                  VE.Set_Value (Value => UI.Match_Value, Context => Context.Get_ELContext.all);
               end;
            end if;

            --  Post an event on this component to trigger the rendering of the completion
            --  list as part of an application/json output.  The rendering is made by Broadcast.
            ASF.Events.Faces.Actions.Post_Event (UI     => UI,
                                                 Method => ME);
         end;
      else
         ASF.Components.Html.Forms.UIInput (UI).Process_Updates (Context);
      end if;

--     exception
--        when E : others =>
--           UI.Is_Valid := False;
--           UI.Add_Message (CONVERTER_MESSAGE_NAME, "convert", Context);
--           Log.Info (Utils.Get_Line_Info (UI)
--                     & ": Exception raised when updating value {0} for component {1}: {2}",
--                     EL.Objects.To_String (UI.Submitted_Value),
--                     To_String (UI.Get_Client_Id), Ada.Exceptions.Exception_Name (E));
   end Process_Updates;

   --  ------------------------------
   --  Broadcast the event to the event listeners installed on this component.
   --  Listeners are called in the order in which they were added.
   --  ------------------------------
   overriding
   procedure Broadcast (UI      : in out UIComplete;
                        Event   : not null access ASF.Events.Faces.Faces_Event'Class;
                        Context : in out Faces_Context'Class) is
      pragma Unreferenced (Event);

      Match  : constant String := Util.Beans.Objects.To_String (UI.Match_Value);
   begin
      Context.Get_Response.Set_Content_Type ("application/json; charset=UTF-8");
      UI.Render_List (Match, Context);
      Context.Response_Completed;
   end Broadcast;

end ASF.Components.Widgets.Inputs;

Use the attribute 'autocompleteList' to define the list of autocompletion


-----------------------------------------------------------------------
--  mat-frames - Representation of stack frames
--  Copyright (C) 2014, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with MAT.Types;
with MAT.Events;
package MAT.Frames is

   Not_Found : exception;

   type Frame_Type is private;

   subtype Frame_Table is MAT.Events.Frame_Table;

   --  Return the parent frame.
   function Parent (Frame : in Frame_Type) return Frame_Type;

   --  Returns the backtrace of the current frame (up to the root).
   --  When <tt>Max_Level</tt> is positive, limit the number of PC frames to the value.
   function Backtrace (Frame     : in Frame_Type;
                       Max_Level : in Natural := 0) return Frame_Table;

   --  Returns all the direct calls made by the current frame.
   function Calls (Frame : in Frame_Type) return Frame_Table;

   --  Returns the number of children in the frame.
   --  When recursive is true, compute in the sub-tree.
   function Count_Children (Frame     : in Frame_Type;
                            Recursive : in Boolean := False) return Natural;

   --  Returns the current stack depth (# of calls from the root
   --  to reach the frame).
   function Current_Depth (Frame : in Frame_Type) return Natural;

   --  Create a root for stack frame representation.
   function Create_Root return Frame_Type;

   --  Destroy the frame tree recursively.
   procedure Destroy (Frame : in out Frame_Type);

   --  Release the frame when its reference is no longer necessary.
   procedure Release (Frame : in Frame_Type);

   --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
   --  If the frame is already known, the frame reference counter is incremented.
   --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
   procedure Insert (Frame  : in Frame_Type;
                     Pc     : in Frame_Table;
                     Result : out Frame_Type);

   --  Find the child frame which has the given PC address.
   --  Returns that frame pointer or raises the Not_Found exception.
   function Find (Frame : in Frame_Type;
                  Pc    : in MAT.Types.Target_Addr) return Frame_Type;

   function Find (Frame : in Frame_Type;
                  Pc    : in Frame_Table) return Frame_Type;

   --  Find the child frame which has the given PC address.
   --  Returns that frame pointer or raises the Not_Found exception.
   procedure Find (Frame   : in Frame_Type;
                   Pc      : in Frame_Table;
                   Result  : out Frame_Type;
                   Last_Pc : out Natural);

   --  Check whether the frame contains a call to the function described by the address range.
   function In_Function (Frame : in Frame_Type;
                         From  : in MAT.Types.Target_Addr;
                         To    : in MAT.Types.Target_Addr) return Boolean;

private

   Frame_Group_Size : constant Natural := 4;

   subtype Local_Depth_Type is Natural range 0 .. Frame_Group_Size;

   subtype Mini_Frame_Table is Frame_Table (1 .. Local_Depth_Type'Last);

   type Frame;
   type Frame_Type is access all Frame;

   type Frame is record
      Parent   : Frame_Type := null;
      Next     : Frame_Type := null;
      Children : Frame_Type := null;
      Used     : Natural   := 0;
      Depth    : Natural   := 0;
      Calls    : Mini_Frame_Table;
      Local_Depth : Local_Depth_Type := 0;
   end record;

end MAT.Frames;

-----------------------------------------------------------------------
--  mat-frames - Representation of stack frames
--  Copyright (C) 2014, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with MAT.Types;
with MAT.Events;
package MAT.Frames is

   Not_Found : exception;

   type Frame_Type is private;

   subtype Frame_Table is MAT.Events.Frame_Table;

   --  Return the parent frame.
   function Parent (Frame : in Frame_Type) return Frame_Type;

   --  Returns the backtrace of the current frame (up to the root).
   --  When <tt>Max_Level</tt> is positive, limit the number of PC frames to the value.
   function Backtrace (Frame     : in Frame_Type;
                       Max_Level : in Natural := 0) return Frame_Table;

   --  Returns all the direct calls made by the current frame.
   function Calls (Frame : in Frame_Type) return Frame_Table;

   --  Returns the number of children in the frame.
   --  When recursive is true, compute in the sub-tree.
   function Count_Children (Frame     : in Frame_Type;
                            Recursive : in Boolean := False) return Natural;

   --  Returns the current stack depth (# of calls from the root
   --  to reach the frame).
   function Current_Depth (Frame : in Frame_Type) return Natural;

   --  Create a root for stack frame representation.
   function Create_Root return Frame_Type;

   --  Destroy the frame tree recursively.
   procedure Destroy (Frame : in out Frame_Type);

   --  Release the frame when its reference is no longer necessary.
   procedure Release (Frame : in Frame_Type);

   --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
   --  If the frame is already known, the frame reference counter is incremented.
   --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
   procedure Insert (Frame  : in Frame_Type;
                     Pc     : in Frame_Table;
                     Result : out Frame_Type);

   --  Find the child frame which has the given PC address.
   --  Returns that frame pointer or raises the Not_Found exception.
   function Find (Frame : in Frame_Type;
                  Pc    : in MAT.Types.Target_Addr) return Frame_Type;

   function Find (Frame : in Frame_Type;
                  Pc    : in Frame_Table) return Frame_Type;

   --  Find the child frame which has the given PC address.
   --  Returns that frame pointer or raises the Not_Found exception.
   procedure Find (Frame   : in Frame_Type;
                   Pc      : in Frame_Table;
                   Result  : out Frame_Type;
                   Last_Pc : out Natural);

   --  Check whether the frame contains a call to the function described by the address range.
   function In_Function (Frame : in Frame_Type;
                         From  : in MAT.Types.Target_Addr;
                         To    : in MAT.Types.Target_Addr) return Boolean;

   --  Check whether the inner most frame contains a call to the function described by
   --  the address range.  This function looks only at the inner most frame and not the
   --  whole stack frame.
   function By_Function (Frame : in Frame_Type;
                         From  : in MAT.Types.Target_Addr;
                         To    : in MAT.Types.Target_Addr) return Boolean;

private

   Frame_Group_Size : constant Natural := 4;

   subtype Local_Depth_Type is Natural range 0 .. Frame_Group_Size;

   subtype Mini_Frame_Table is Frame_Table (1 .. Local_Depth_Type'Last);

   type Frame;
   type Frame_Type is access all Frame;

   type Frame is record
      Parent   : Frame_Type := null;
      Next     : Frame_Type := null;
      Children : Frame_Type := null;
      Used     : Natural   := 0;
      Depth    : Natural   := 0;
      Calls    : Mini_Frame_Table;
      Local_Depth : Local_Depth_Type := 0;
   end record;

end MAT.Frames;

Declare the By_Function function

Declare the By_Function function


-----------------------------------------------------------------------
--  mat-callbacks - Callbacks for Gtk
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with MAT.Types;
with Gtkada.Builder;
package MAT.Callbacks is

   --  Initialize and register the callbacks.
   procedure Initialize (Builder : in Gtkada.Builder.Gtkada_Builder);

   --  Callback executed when the "quit" action is executed from the menu.
   procedure On_Menu_Quit (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

   --  Callback executed when the "about" action is executed from the menu.
   procedure On_Menu_About (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

   --  Callback executed when the "close-about" action is executed from the about box.
   procedure On_Close_About (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

end MAT.Callbacks;

-----------------------------------------------------------------------
--  mat-callbacks - Callbacks for Gtk
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Gtkada.Builder;

with MAT.Targets.Gtkmat;
package MAT.Callbacks is

   --  Initialize and register the callbacks.
   procedure Initialize (Target  : in MAT.Targets.Gtkmat.Target_Type_Access;
                         Builder : in Gtkada.Builder.Gtkada_Builder);

   --  Callback executed when the "quit" action is executed from the menu.
   procedure On_Menu_Quit (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

   --  Callback executed when the "about" action is executed from the menu.
   procedure On_Menu_About (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

   --  Callback executed when the "close-about" action is executed from the about box.
   procedure On_Close_About (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

end MAT.Callbacks;

Add the Target_Type_Access parameter to the Initialize procedure


-----------------------------------------------------------------------
--  gen-commands-layout -- Layout creation command for dynamo
--  Copyright (C) 2011, 2012, 2013, 2014, 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Text_IO;
with Gen.Artifacts;

with Util.Strings;
with Util.Files;
package body Gen.Commands.Layout is

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Cmd       : in out Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Name);
      use Ada.Strings.Unbounded;

      function Get_Name return String;

      Dir        : constant String := Generator.Get_Result_Directory;
      Layout_Dir : constant String := Util.Files.Compose (Dir, "web/WEB-INF/layouts");

      function Get_Name return String is
         Name : constant String := (if Args.Get_Count > 0 then Args.Get_Argument (1) else "");
         Pos  : constant Natural := Util.Strings.Rindex (Name, '.');
      begin
         if Pos = 0 then
            return Name;
         elsif Name (Pos .. Name'Last) = ".xhtml" then
            return Name (Name'First .. Pos - 1);
         elsif Name (Pos .. Name'Last) = ".html" then
            return Name (Name'First .. Pos - 1);
         else
            return Name;
         end if;
      end Get_Name;

      Page_Name : constant String := Get_Name;
   begin
      if Page_Name'Length = 0 then
         Cmd.Usage (Name);
         return;
      end if;

      Generator.Set_Force_Save (False);
      Generator.Set_Result_Directory (Layout_Dir);
      Generator.Set_Global ("pageName", Page_Name);
      Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "layout");
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;

   begin
      Put_Line ("add-layout: Add a new layout page to the application");
      Put_Line ("Usage: add-layout NAME");
      New_Line;
      Put_Line ("  The layout page allows to give a common look to a set of pages.");
      Put_Line ("  You can create several layouts for your application.");
      Put_Line ("  Each layout can reference one or several building blocks that are defined");
      Put_Line ("  in the original page.");
      New_Line;
      Put_Line ("  The following files are generated:");
      Put_Line ("    web/WEB-INF/layouts/<name>.xhtml");
   end Help;

end Gen.Commands.Layout;

-----------------------------------------------------------------------
--  gen-commands-layout -- Layout creation command for dynamo
--  Copyright (C) 2011, 2012, 2013, 2014, 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Text_IO;
with Gen.Artifacts;

with Util.Strings;
with Util.Files;
package body Gen.Commands.Layout is

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Cmd       : in out Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler) is
      use Ada.Strings.Unbounded;

      function Get_Name return String;

      Dir        : constant String := Generator.Get_Result_Directory;
      Layout_Dir : constant String := Util.Files.Compose (Dir, "web/WEB-INF/layouts");

      function Get_Name return String is
         Name : constant String := (if Args.Get_Count > 0 then Args.Get_Argument (1) else "");
         Pos  : constant Natural := Util.Strings.Rindex (Name, '.');
      begin
         if Pos = 0 then
            return Name;
         elsif Name (Pos .. Name'Last) = ".xhtml" then
            return Name (Name'First .. Pos - 1);
         elsif Name (Pos .. Name'Last) = ".html" then
            return Name (Name'First .. Pos - 1);
         else
            return Name;
         end if;
      end Get_Name;

      Page_Name : constant String := Get_Name;
   begin
      if Page_Name'Length = 0 then
         Cmd.Usage (Name);
         return;
      end if;

      Generator.Set_Force_Save (False);
      Generator.Set_Result_Directory (Layout_Dir);
      Generator.Set_Global ("pageName", Page_Name);
      Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "layout");
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;

   begin
      Put_Line ("add-layout: Add a new layout page to the application");
      Put_Line ("Usage: add-layout NAME");
      New_Line;
      Put_Line ("  The layout page allows to give a common look to a set of pages.");
      Put_Line ("  You can create several layouts for your application.");
      Put_Line ("  Each layout can reference one or several building blocks that are defined");
      Put_Line ("  in the original page.");
      New_Line;
      Put_Line ("  The following files are generated:");
      Put_Line ("    web/WEB-INF/layouts/<name>.xhtml");
   end Help;

end Gen.Commands.Layout;

Fix compilation warnings

Fix compilation warnings


with Ada.Containers.Ordered_Sets;
with Ada.Unchecked_Deallocation;
with Ada.Text_IO;

package body Decipherer is
   package Character_Sets is new Ada.Containers.Ordered_Sets(Element_Type => Encrypted_Char);
   package IO renames Ada.Text_IO;

   type Mapping_Candidates is Array(Positive range 1 .. 26) of Character;

   type Char_Possibilities is record
      c : Encrypted_Char;
      num_possible : Natural;
      possibilities : Mapping_Candidates;
   end record;

   type Word_Possibilities is record
      is_using_root : Boolean;
      words : Word_List.Word_Vector;
   end record;

   type Char_Possibilities_Array is Array(Positive range <>) of Char_Possibilities;
   type Word_Possibilities_Array is Array(Positive range <>) of Word_Possibilities;
   type Word_Inclusion is Array(Positive range <>, Positive range <>) of Natural;

   type Letter_Toggle is Array(Positive range <>) of Boolean;
   type Word_Toggle is Array(Positive range <>) of Boolean;

   package Word_Vectors renames Word_List.Word_Vectors;
   function "="(a, b: Word_Vectors.Cursor) return Boolean renames Word_Vectors."=";
   procedure Free_Word_Vector is new Ada.Unchecked_Deallocation(Object => Word_Vectors.Vector, Name => Word_List.Word_Vector);

   type Decipher_State (num_words : Positive; num_letters : Positive) is record
      candidates : Candidate_Set(1 .. num_words);
      characters : Char_Possibilities_Array(1 .. num_letters);
      words : Word_Possibilities_Array(1 .. num_words);
      inclusion : Word_Inclusion(1 .. num_letters, 1 .. num_words);
   end record;

   function Image(ew: Encrypted_Word) return Word_List.Word is
      w : Word_List.Word;
   begin
      for i in ew'Range loop
         w(i) := Character(ew(i));
      end loop;
      return w;
   end Image;

   function Get_Character_Index(state : Decipher_State; c : Encrypted_Char) return Positive is
   begin
      for ci in state.characters'Range loop
         if c = state.characters(ci).c then
            return ci;
         end if;
      end loop;
      raise Constraint_Error;
   end Get_Character_Index;

   function Is_Word_Valid(state : Decipher_State; candidate : Encrypted_Word; word : Word_List.Word) return Boolean is
   begin
      for i in candidate'Range loop
         exit when candidate(i) = ' ';
         declare
            ci : constant Positive := Get_Character_Index(state, candidate(i));
            c : constant Character := word(i);
            cp : Char_Possibilities renames state.characters(ci);
            found : Boolean := False;
         begin
            if cp.num_possible = 1 then
               found := cp.possibilities(1) = c;
            elsif cp.num_possible = 26 then
               found := True;
            else
               for j in 1 .. cp.num_possible loop
                  if cp.possibilities(j) = c then
                     found := True;
                     exit;
                  end if;
               end loop;
            end if;
            if not found then
               return False;
            end if;
         end;
      end loop;
      return True;
   end Is_Word_Valid;

   procedure Filter_Word_List(state : Decipher_State; candidate : Encrypted_Word; initial : Word_List.Word_Vector; final : Word_List.Word_Vector) is
      cur : Word_Vectors.Cursor := initial.First;
   begin
      while cur /= Word_Vectors.No_Element loop
         if Is_Word_Valid(state, candidate, Word_Vectors.Element(cur)) then
            final.Append(Word_Vectors.Element(cur));
         end if;
         cur := Word_Vectors.Next(cur);
      end loop;
   end Filter_Word_List;

   procedure Put_Possible(cp: Char_Possibilities) is
   begin
      for i in 1 .. cp.Num_Possible loop
         IO.Put(cp.possibilities(i));
      end loop;
      IO.New_Line;
   end Put_Possible;

   procedure Put_Inclusion(state: Decipher_State) is
   begin
      for i in 1 .. state.Num_Letters loop
         IO.Put(Encrypted_Char'Image(state.characters(i).c) & ": ");
         for j in 1 .. state.Num_Words loop
            exit when state.inclusion(i, j) = 0;
            IO.Put(Natural'Image(state.inclusion(i, j)));
         end loop;
         IO.New_Line;
      end loop;
   end Put_Inclusion;

   procedure Make_Unique(state : in out Decipher_State; ci : Positive; success : out Boolean; changed : in out Letter_Toggle) is
      letter : constant Character := state.characters(ci).possibilities(1);
   begin
      success := True;
      --  IO.Put_Line("Determined that " & Encrypted_Char'Image(state.characters(ci).c) & " has to be a " & Character'Image(letter));
      for i in state.characters'Range loop
         if i /= ci then
            declare
               cp : Char_Possibilities renames state.characters(i);
            begin
               for j in 1 .. cp.num_possible loop
                  if cp.possibilities(j) = letter then
                     if cp.num_possible = 1 then
                        success := False;
                        return;
                     else
                        --  IO.Put("Before: "); Put_Possible(cp);
                        cp.possibilities(j .. cp.num_possible - 1) := cp.possibilities(j + 1 .. cp.num_possible);
                        cp.num_possible := cp.num_possible - 1;
                        --  IO.Put("After: "); Put_Possible(cp);
                        changed(i) := True;
                        if cp.num_possible = 1 then
                           --  IO.Put_Line("Make_Unique from Make_Unique");
                           Make_Unique(state, i, success, changed);
                           if not success then
                              return;
                           end if;
                        end if;
                        exit;
                     end if;
                  end if;
               end loop;
            end;
         end if;
      end loop;
   end Make_Unique;

   procedure Constrain_Letters(state : in out Decipher_State;  wi : Positive; success : out Boolean; changed : in out Letter_Toggle) is
      ci : Positive;
      cur : Word_Vectors.Cursor := state.words(wi).words.all.First;
      word : Word_List.Word;
      seen : Array(Positive range 1 .. state.num_letters, Character range 'a' .. 'z') of Boolean := (others => (others => False));
      used : Array(Positive range 1 .. state.num_letters) of Boolean := (others => False);
   begin
      success := True;
      while cur /= Word_Vectors.No_Element loop
         word := Word_Vectors.Element(cur);
         for i in word'Range loop
            exit when word(i) = ' ';
            ci := Get_Character_Index(state, state.candidates(wi)(i));
            seen(ci, word(i)) := True;
            used(ci) := True;
         end loop;
         cur := Word_Vectors.Next(cur);
      end loop;
      for i in used'range loop
         if used(i) then
            --  IO.Put("Seen: ");
            --  for c in Character range 'a' .. 'z' loop
            --     if (seen(i, c)) then
            --        IO.Put(c);
            --     end if;
            --  end loop;
            --  IO.New_Line;
            declare
               cp : Char_Possibilities renames state.characters(i);
               shrunk : Boolean := False;
               write_head : Natural := 0;
            begin
               --  IO.Put("Before: "); Put_Possible(cp);
               for read_head in 1 .. cp.Num_Possible loop
                  if seen(i, cp.possibilities(read_head)) then
                     write_head := write_head + 1;
                     if write_head /= read_head then
                        cp.possibilities(write_head) := cp.possibilities(read_head);
                     end if;
                  else
                     shrunk := True;
                  end if;
               end loop;
               cp.Num_Possible := write_head;
               --  IO.Put("After: "); Put_Possible(cp);
               if Shrunk then
                  changed(i) := True;
                  if cp.Num_Possible = 0 then
                     success := False;
                     return;
                  elsif cp.Num_Possible = 1 then
                     --  IO.Put_Line("Make_Unique from Constrain_Letters");
                     Make_Unique(state, i, success, changed);
                     if not success then
                        return;
                     end if;
                  end if;
               end if;
            end;
         end if;
      end loop;
   end Constrain_Letters;

   procedure Check_Constraints(state : in out Decipher_State; changed : Letter_Toggle; success : out Boolean) is
      words : Word_Toggle(1 .. state.num_words) := (others => False);
      follow_up : Letter_Toggle(1 .. state.num_letters) := (others => False);
      any_changed : Boolean := False;
   begin
      success := True;
      for i in 1 .. state.num_letters loop
         if changed(i) then
            any_changed := True;
            for j in 1 .. state.num_words loop
               exit when state.inclusion(i, j) = 0;
               words(state.inclusion(i, j)) := True;
            end loop;
         end if;
      end loop;
      if not any_changed then
         return;
      end if;
      for i in 1 .. state.num_words loop
         if words(i) then
            declare
               new_words : Word_List.Word_Vector := new Word_Vectors.Vector;
            begin
               Filter_Word_List(state, state.candidates(i), state.words(i).words, new_words);
               if Natural(new_words.Length) = 0 then
                  Free_Word_Vector(new_words);
                  success := False;
                  return;
               elsif Natural(new_words.Length) = Natural(state.words(i).words.Length) then
                  --  IO.Put_Line("Word set for " & Positive'Image(i) & "(" & Image(state.candidates(i)) & ") did not shrink from " & Ada.Containers.Count_Type'Image(state.words(i).words.all.Length));
                  Free_Word_Vector(new_Words);
               else
                  --  IO.Put_Line("Restricting word set for " & Positive'Image(i) & "(" & Image(state.candidates(i)) & ") from " & Ada.Containers.Count_Type'Image(state.words(i).words.all.Length) & " to " & Ada.Containers.Count_Type'Image(new_words.all.Length));
                  if state.words(i).is_using_root then
                     state.words(i).is_using_root := False;
                  else
                     Free_Word_Vector(state.words(i).words);
                  end if;
                  state.words(i).words := new_words;
                  Constrain_Letters(state, i, success, follow_up);
                  if not success then
                     return;
                  end if;
               end if;
            end;
         end if;
      end loop;
      Check_Constraints(state, follow_up, success);
   end Check_Constraints;

   procedure Guess_Letter(state : in out Decipher_State; ci : Positive) is
   begin
      if ci > state.num_letters then
         IO.Put_Line("Found Solution");
         for ci in 1 .. state.num_letters loop
            IO.Put(Character(state.characters(ci).c));
            if state.characters(ci).num_possible /= 1 then
               IO.Put_Line(": Invalid State");
               return;
            end if;
         end loop;
         IO.New_Line;
         for ci in 1 .. state.num_letters loop
            IO.Put(state.characters(ci).possibilities(1));
         end loop;
         IO.New_Line;
         for wi in 1 .. state.num_words loop
            IO.Put(Image(state.candidates(wi)) & ": ");
            if Natural(state.words(wi).words.all.Length) = 1 then
               IO.Put_Line(state.words(wi).words.all(1));
            else
               IO.Put_Line("*Invalid: " & Ada.Containers.Count_Type'Image(state.words(wi).words.all.Length) & " Words");
            end if;
         end loop;
         IO.Put_Line("--------------------------");
      elsif state.characters(ci).num_possible = 1 then
         -- Nothing to do, pass it up the line
         Guess_Letter(state, ci + 1);
      else
         declare
            success : Boolean;
            changed : Letter_Toggle(1 .. state.num_letters);
            characters : constant Char_Possibilities_Array := state.characters;
            words : constant Word_Possibilities_Array := state.words;
            cp : Char_Possibilities renames characters(ci);
         begin
            for mi in 1 .. cp.num_possible loop
               changed := (others => False);
               changed(ci) := True;
               state.characters(ci).possibilities(1) := characters(ci).possibilities(mi);
               --  IO.Put_Line("Guessing " & Character'Image(state.characters(ci).possibilities(mi)) & " for " & Encrypted_Char'Image(state.characters(ci).c));
               state.characters(ci).num_possible := 1;
               for wi in 1 .. state.num_words loop
                  state.words(wi).is_using_root := True;
               end loop;
               --  IO.Put_Line("Make_Unique from Guess_Letter");
               Make_Unique(state, ci, success, changed);
               if success then
                  Check_Constraints(state, changed, success);
                  if success then
                     Guess_Letter(state, ci + 1);
                  end if;
               end if;
               --  IO.Put_Line("Restore Letter guess for " & Positive'Image(ci));
               state.characters := characters;
               state.words := words;
            end loop;
         end;
      end if;
   end Guess_Letter;

   function Decipher(candidates: Candidate_Set; words: Word_List.Word_List) return Result_Set is
      letters : Character_Sets.Set;
   begin
      for ci in candidates'Range loop
         for i in candidates(ci)'Range loop
            exit when candidates(ci)(i) = ' ';
            letters.Include(candidates(ci)(i));
         end loop;
      end loop;
      declare
         num_words : constant Positive := Positive(candidates'Length);
         num_letters : constant Positive := Positive(letters.Length);
         result : Result_Set(1 .. num_letters);
         state : Decipher_State(num_words, num_letters);
         cur : Character_Sets.Cursor := letters.First;
      begin
         state.candidates := candidates;
         state.inclusion := (others => (others => 0));
         for i in 1 .. num_letters loop
            state.characters(i).c := Character_Sets.Element(cur);
            state.characters(i).num_possible := 26;
            for l in Character range 'a' .. 'z' loop
               state.characters(i).possibilities(Character'Pos(l) - Character'Pos('a') + 1) := l;
            end loop;
            cur := Character_Sets.Next(cur);
         end loop;
         for i in 1 .. num_words loop
            for l in candidates(Candidates'First + i - 1)'Range loop
               declare
                  c : constant Encrypted_Char := candidates(Candidates'First + i - 1)(l);
                  ci : Positive;
               begin
                  exit when c = ' ';
                  ci := Get_Character_Index(state, c);
                  for mi in 1 .. num_words loop
                     if state.inclusion(ci, mi) = 0 then
                        state.inclusion(ci, mi) := i;
                        exit;
                     elsif state.inclusion(ci, mi) = i then
                        exit;
                     end if;
                  end loop;
               end;
            end loop;
            state.words(i).is_using_root := True;
            state.words(i).words := words.Element(Word_List.Make_Pattern(Image(candidates(i))));
         end loop;
         -- Put_Inclusion(state);
         Guess_Letter(state, 1);
         return result;
      end;
   end Decipher;

end Decipherer;

with Ada.Containers.Ordered_Sets;
with Ada.Unchecked_Deallocation;
with Ada.Containers.Generic_Array_Sort;
with Ada.Text_IO;

package body Decipherer is
   package Character_Sets is new Ada.Containers.Ordered_Sets(Element_Type => Encrypted_Char);
   package IO renames Ada.Text_IO;

   type Priority_Pair is record
      item, priority : Integer;
   end record;
   type Priority_Pair_Array is Array(Positive range <>) of Priority_Pair;

   function "<"(a, b : Priority_Pair) return Boolean is
   begin
      return a.priority > b.priority;
   end "<";

   procedure Priority_Pair_Sort is new Ada.Containers.Generic_Array_Sort(Index_Type => Positive, Element_Type => Priority_Pair, Array_Type => Priority_Pair_Array);

   type Mapping_Candidates is Array(Positive range 1 .. 26) of Character;

   type Char_Possibilities is record
      c : Encrypted_Char;
      num_possible : Natural;
      possibilities : Mapping_Candidates;
   end record;

   type Word_Possibilities is record
      is_using_root : Boolean;
      words : Word_List.Word_Vector;
   end record;

   type Guess_Order_Array is Array(Positive range <>) of Positive;
   type Char_Possibilities_Array is Array(Positive range <>) of Char_Possibilities;
   type Word_Possibilities_Array is Array(Positive range <>) of Word_Possibilities;
   type Word_Inclusion is Array(Positive range <>, Positive range <>) of Natural;

   type Letter_Toggle is Array(Positive range <>) of Boolean;
   type Word_Toggle is Array(Positive range <>) of Boolean;

   package Word_Vectors renames Word_List.Word_Vectors;
   function "="(a, b: Word_Vectors.Cursor) return Boolean renames Word_Vectors."=";
   procedure Free_Word_Vector is new Ada.Unchecked_Deallocation(Object => Word_Vectors.Vector, Name => Word_List.Word_Vector);

   type Decipher_State (num_words : Positive; num_letters : Positive) is record
      candidates : Candidate_Set(1 .. num_words);
      characters : Char_Possibilities_Array(1 .. num_letters);
      words : Word_Possibilities_Array(1 .. num_words);
      inclusion : Word_Inclusion(1 .. num_letters, 1 .. num_words);
      guess_order : Guess_Order_Array(1 .. num_letters);
   end record;

   function Image(ew: Encrypted_Word) return Word_List.Word is
      w : Word_List.Word;
   begin
      for i in ew'Range loop
         w(i) := Character(ew(i));
      end loop;
      return w;
   end Image;

   function Get_Character_Index(state : Decipher_State; c : Encrypted_Char) return Positive is
   begin
      for ci in state.characters'Range loop
         if c = state.characters(ci).c then
            return ci;
         end if;
      end loop;
      raise Constraint_Error;
   end Get_Character_Index;

   function Is_Word_Valid(state : Decipher_State; candidate : Encrypted_Word; word : Word_List.Word) return Boolean is
   begin
      for i in candidate'Range loop
         exit when candidate(i) = ' ';
         declare
            ci : constant Positive := Get_Character_Index(state, candidate(i));
            c : constant Character := word(i);
            cp : Char_Possibilities renames state.characters(ci);
            found : Boolean := False;
         begin
            if cp.num_possible = 1 then
               found := cp.possibilities(1) = c;
            elsif cp.num_possible = 26 then
               found := True;
            else
               for j in 1 .. cp.num_possible loop
                  if cp.possibilities(j) = c then
                     found := True;
                     exit;
                  end if;
               end loop;
            end if;
            if not found then
               return False;
            end if;
         end;
      end loop;
      return True;
   end Is_Word_Valid;

   procedure Filter_Word_List(state : Decipher_State; candidate : Encrypted_Word; initial : Word_List.Word_Vector; final : Word_List.Word_Vector) is
      cur : Word_Vectors.Cursor := initial.First;
   begin
      while cur /= Word_Vectors.No_Element loop
         if Is_Word_Valid(state, candidate, Word_Vectors.Element(cur)) then
            final.Append(Word_Vectors.Element(cur));
         end if;
         cur := Word_Vectors.Next(cur);
      end loop;
   end Filter_Word_List;

   procedure Put_Possible(cp: Char_Possibilities) is
   begin
      for i in 1 .. cp.Num_Possible loop
         IO.Put(cp.possibilities(i));
      end loop;
      IO.New_Line;
   end Put_Possible;

   procedure Put_Inclusion(state: Decipher_State) is
   begin
      for i in 1 .. state.Num_Letters loop
         IO.Put(Encrypted_Char'Image(state.characters(i).c) & ": ");
         for j in 1 .. state.Num_Words loop
            exit when state.inclusion(i, j) = 0;
            IO.Put(Natural'Image(state.inclusion(i, j)));
         end loop;
         IO.New_Line;
      end loop;
   end Put_Inclusion;

   procedure Make_Unique(state : in out Decipher_State; ci : Positive; success : out Boolean; changed : in out Letter_Toggle) is
      letter : constant Character := state.characters(ci).possibilities(1);
   begin
      success := True;
      --  IO.Put_Line("Determined that " & Encrypted_Char'Image(state.characters(ci).c) & " has to be a " & Character'Image(letter));
      for i in state.characters'Range loop
         if i /= ci then
            declare
               cp : Char_Possibilities renames state.characters(i);
            begin
               for j in 1 .. cp.num_possible loop
                  if cp.possibilities(j) = letter then
                     if cp.num_possible = 1 then
                        success := False;
                        return;
                     else
                        --  IO.Put("Before: "); Put_Possible(cp);
                        cp.possibilities(j .. cp.num_possible - 1) := cp.possibilities(j + 1 .. cp.num_possible);
                        cp.num_possible := cp.num_possible - 1;
                        --  IO.Put("After: "); Put_Possible(cp);
                        changed(i) := True;
                        if cp.num_possible = 1 then
                           --  IO.Put_Line("Make_Unique from Make_Unique");
                           Make_Unique(state, i, success, changed);
                           if not success then
                              return;
                           end if;
                        end if;
                        exit;
                     end if;
                  end if;
               end loop;
            end;
         end if;
      end loop;
   end Make_Unique;

   procedure Constrain_Letters(state : in out Decipher_State;  wi : Positive; success : out Boolean; changed : in out Letter_Toggle) is
      ci : Positive;
      cur : Word_Vectors.Cursor := state.words(wi).words.all.First;
      word : Word_List.Word;
      seen : Array(Positive range 1 .. state.num_letters, Character range 'a' .. 'z') of Boolean := (others => (others => False));
      used : Array(Positive range 1 .. state.num_letters) of Boolean := (others => False);
   begin
      success := True;
      while cur /= Word_Vectors.No_Element loop
         word := Word_Vectors.Element(cur);
         for i in word'Range loop
            exit when word(i) = ' ';
            ci := Get_Character_Index(state, state.candidates(wi)(i));
            seen(ci, word(i)) := True;
            used(ci) := True;
         end loop;
         cur := Word_Vectors.Next(cur);
      end loop;
      for i in used'range loop
         if used(i) then
            --  IO.Put("Seen: ");
            --  for c in Character range 'a' .. 'z' loop
            --     if (seen(i, c)) then
            --        IO.Put(c);
            --     end if;
            --  end loop;
            --  IO.New_Line;
            declare
               cp : Char_Possibilities renames state.characters(i);
               shrunk : Boolean := False;
               write_head : Natural := 0;
            begin
               --  IO.Put("Before: "); Put_Possible(cp);
               for read_head in 1 .. cp.Num_Possible loop
                  if seen(i, cp.possibilities(read_head)) then
                     write_head := write_head + 1;
                     if write_head /= read_head then
                        cp.possibilities(write_head) := cp.possibilities(read_head);
                     end if;
                  else
                     shrunk := True;
                  end if;
               end loop;
               cp.Num_Possible := write_head;
               --  IO.Put("After: "); Put_Possible(cp);
               if Shrunk then
                  changed(i) := True;
                  if cp.Num_Possible = 0 then
                     success := False;
                     return;
                  elsif cp.Num_Possible = 1 then
                     --  IO.Put_Line("Make_Unique from Constrain_Letters");
                     Make_Unique(state, i, success, changed);
                     if not success then
                        return;
                     end if;
                  end if;
               end if;
            end;
         end if;
      end loop;
   end Constrain_Letters;

   procedure Check_Constraints(state : in out Decipher_State; changed : Letter_Toggle; success : out Boolean) is
      words : Word_Toggle(1 .. state.num_words) := (others => False);
      follow_up : Letter_Toggle(1 .. state.num_letters) := (others => False);
      any_changed : Boolean := False;
   begin
      success := True;
      for i in 1 .. state.num_letters loop
         if changed(i) then
            any_changed := True;
            for j in 1 .. state.num_words loop
               exit when state.inclusion(i, j) = 0;
               words(state.inclusion(i, j)) := True;
            end loop;
         end if;
      end loop;
      if not any_changed then
         return;
      end if;
      for i in 1 .. state.num_words loop
         if words(i) then
            declare
               new_words : Word_List.Word_Vector := new Word_Vectors.Vector;
            begin
               Filter_Word_List(state, state.candidates(i), state.words(i).words, new_words);
               if Natural(new_words.Length) = 0 then
                  Free_Word_Vector(new_words);
                  success := False;
                  return;
               elsif Natural(new_words.Length) = Natural(state.words(i).words.Length) then
                  --  IO.Put_Line("Word set for " & Positive'Image(i) & "(" & Image(state.candidates(i)) & ") did not shrink from " & Ada.Containers.Count_Type'Image(state.words(i).words.all.Length));
                  Free_Word_Vector(new_Words);
               else
                  --  IO.Put_Line("Restricting word set for " & Positive'Image(i) & "(" & Image(state.candidates(i)) & ") from " & Ada.Containers.Count_Type'Image(state.words(i).words.all.Length) & " to " & Ada.Containers.Count_Type'Image(new_words.all.Length));
                  if state.words(i).is_using_root then
                     state.words(i).is_using_root := False;
                  else
                     Free_Word_Vector(state.words(i).words);
                  end if;
                  state.words(i).words := new_words;
                  Constrain_Letters(state, i, success, follow_up);
                  if not success then
                     return;
                  end if;
               end if;
            end;
         end if;
      end loop;
      Check_Constraints(state, follow_up, success);
   end Check_Constraints;

   procedure Guess_Letter(state : in out Decipher_State; gi : Positive) is
   begin
      if gi > state.num_letters then
         IO.Put_Line("Found Solution");
         for ci in 1 .. state.num_letters loop
            IO.Put(Character(state.characters(ci).c));
            if state.characters(ci).num_possible /= 1 then
               IO.Put_Line(": Invalid State");
               return;
            end if;
         end loop;
         IO.New_Line;
         for ci in 1 .. state.num_letters loop
            IO.Put(state.characters(ci).possibilities(1));
         end loop;
         IO.New_Line;
         for wi in 1 .. state.num_words loop
            IO.Put(Image(state.candidates(wi)) & ": ");
            if Natural(state.words(wi).words.all.Length) = 1 then
               IO.Put_Line(state.words(wi).words.all(1));
            else
               IO.Put_Line("*Invalid: " & Ada.Containers.Count_Type'Image(state.words(wi).words.all.Length) & " Words");
            end if;
         end loop;
         IO.Put_Line("--------------------------");
      else
         declare
            ci : constant Positive := state.guess_order(gi);
         begin
            if state.characters(ci).num_possible = 1 then
               -- Nothing to do, pass it up the line
               Guess_Letter(state, ci + 1);
            else
               declare
                  success : Boolean;
                  changed : Letter_Toggle(1 .. state.num_letters);
                  characters : constant Char_Possibilities_Array := state.characters;
                  words : constant Word_Possibilities_Array := state.words;
                  cp : Char_Possibilities renames characters(ci);
               begin
                  for mi in 1 .. cp.num_possible loop
                     changed := (others => False);
                     changed(ci) := True;
                     state.characters(ci).possibilities(1) := characters(ci).possibilities(mi);
                     --  IO.Put_Line("Guessing " & Character'Image(state.characters(ci).possibilities(mi)) & " for " & Encrypted_Char'Image(state.characters(ci).c));
                     state.characters(ci).num_possible := 1;
                     for wi in 1 .. state.num_words loop
                        state.words(wi).is_using_root := True;
                     end loop;
                     --  IO.Put_Line("Make_Unique from Guess_Letter");
                     Make_Unique(state, ci, success, changed);
                     if success then
                        Check_Constraints(state, changed, success);
                        if success then
                           Guess_Letter(state, ci + 1);
                        end if;
                     end if;
                     --  IO.Put_Line("Restore Letter guess for " & Positive'Image(ci));
                     state.characters := characters;
                     state.words := words;
                  end loop;
               end;
            end if;
         end;
      end if;
   end Guess_Letter;

   function Decipher(candidates: Candidate_Set; words: Word_List.Word_List) return Result_Set is
      letters : Character_Sets.Set;
   begin
      for ci in candidates'Range loop
         for i in candidates(ci)'Range loop
            exit when candidates(ci)(i) = ' ';
            letters.Include(candidates(ci)(i));
         end loop;
      end loop;
      declare
         num_words : constant Positive := Positive(candidates'Length);
         num_letters : constant Positive := Positive(letters.Length);
         result : Result_Set(1 .. num_letters);
         state : Decipher_State(num_words, num_letters);
         cur : Character_Sets.Cursor := letters.First;
         inclusion_priority : Priority_Pair_Array(1 .. num_letters);
      begin
         state.candidates := candidates;
         state.inclusion := (others => (others => 0));
         for i in 1 .. num_letters loop
            state.characters(i).c := Character_Sets.Element(cur);
            state.characters(i).num_possible := 26;
            inclusion_priority(i) := (item => i, priority => 0);
            for l in Character range 'a' .. 'z' loop
               state.characters(i).possibilities(Character'Pos(l) - Character'Pos('a') + 1) := l;
            end loop;
            cur := Character_Sets.Next(cur);
         end loop;
         for i in 1 .. num_words loop
            for l in candidates(Candidates'First + i - 1)'Range loop
               declare
                  c : constant Encrypted_Char := candidates(Candidates'First + i - 1)(l);
                  ci : Positive;
               begin
                  exit when c = ' ';
                  ci := Get_Character_Index(state, c);
                  for mi in 1 .. num_words loop
                     if state.inclusion(ci, mi) = 0 then
                        state.inclusion(ci, mi) := i;
                        inclusion_priority(ci).priority := mi;
                        exit;
                     elsif state.inclusion(ci, mi) = i then
                        exit;
                     end if;
                  end loop;
               end;
            end loop;
            state.words(i).is_using_root := True;
            state.words(i).words := words.Element(Word_List.Make_Pattern(Image(candidates(i))));
         end loop;
         Priority_Pair_Sort(inclusion_priority);
         -- Put_Inclusion(state);
         for i in inclusion_priority'range loop
            state.guess_order(i) := inclusion_priority(i).item;
            -- IO.Put_Line("Guess " & Integer'Image(i) & " is " & Encrypted_Char'Image(state.characters(inclusion_priority(i).item).c) & " with " & Integer'Image(inclusion_priority(i).priority) & " words connected to it");
         end loop;

         Guess_Letter(state, 1);
         return result;
      end;
   end Decipher;

end Decipherer;

Sort the letters by word frequency, which removes the performance penalty for rot1
encoding the test input.

I imagine I'm paying a performance penalty for the fact that everything is copying around
24 bytes for every string used (so if I reduce a word list from 3000 words to 2000 words I
copy 2000 24 character words instead of just 2000 integers), but in release mode it
currently runs in .1 seconds on my machine.

For comparison, perl runs in just over 1 second and debug mode runs in about 3/4 of a
second.


-----------------------------------------------------------------------
--  wiki-streams-text_io -- Text_IO input output streams
--  Copyright (C) 2016, 2022 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.IO_Exceptions;

with Wiki.Helpers;
package body Wiki.Streams.Text_IO is

   --  ------------------------------
   --  Open the file and prepare to read the input stream.
   --  ------------------------------
   procedure Open (Stream : in out File_Input_Stream;
                   Path   : in String;
                   Form   : in String := "") is
   begin
      Ada.Wide_Wide_Text_IO.Open (Stream.File, Ada.Wide_Wide_Text_IO.In_File, Path, Form);
      Stream.Stdin := False;
   end Open;

   --  ------------------------------
   --  Close the file.
   --  ------------------------------
   procedure Close (Stream : in out File_Input_Stream) is
   begin
      if Ada.Wide_Wide_Text_IO.Is_Open (Stream.File) then
         Ada.Wide_Wide_Text_IO.Close (Stream.File);
      end if;
   end Close;

   --  ------------------------------
   --  Close the stream.
   --  ------------------------------
   overriding
   procedure Finalize (Stream : in out File_Input_Stream) is
   begin
      Stream.Close;
   end Finalize;

   --  ------------------------------
   --  Read the input stream and fill the `Into` buffer until either it is full or
   --  we reach the end of line.  Returns in `Last` the last valid position in the
   --  `Into` buffer.  When there is no character to read, return True in
   --  the `Eof` indicator.
   --  ------------------------------
   overriding
   procedure Read (Input : in out File_Input_Stream;
                   Into  : in out Wiki.Strings.WString;
                   Last  : out Natural;
                   Eof   : out Boolean) is
      Available : Boolean;
      Pos       : Natural := Into'First;
      Char      : Wiki.Strings.WChar;
   begin
      if Input.Stdin then
         if not Ada.Wide_Wide_Text_Io.End_Of_File then
            Ada.Wide_Wide_Text_IO.Get_Line (Into, Last);
            if Last < Into'Last then
               Into (Last + 1) := Helpers.Lf;
               Last := Last + 1;
            end if;
            Eof := False;
         else
            Last := Into'First - 1;
            Eof := True;
         end if;
      else
         if not Ada.Wide_Wide_Text_Io.End_Of_File (Input.File) then
            Ada.Wide_Wide_Text_IO.Get_Line (Input.File, Into, Last);
            if Last < Into'Last then
               Into (Last + 1) := Helpers.Lf;
               Last := Last + 1;
            end if;
            Eof := False;
         else
            Last := Into'First - 1;
            Eof := True;
         end if;
      end if;
--      Eof := False;
--      while Pos <= Into'Last loop
--         if Input.Stdin then
--            Ada.Wide_Wide_Text_IO.Get_Immediate (Char, Available);
--         else
--            Ada.Wide_Wide_Text_IO.Get_Immediate (Input.File, Char, Available);
--         end if;
--         Into (Pos) := Char;
--         Pos := Pos + 1;
--         exit when Char = Helpers.LF or Char = Helpers.CR;
--      end loop;
--      Last := Pos - 1;

   exception
      when Ada.IO_Exceptions.End_Error =>
         Last := Pos - 1;
         Eof  := True;

   end Read;

   --  ------------------------------
   --  Open the file and prepare to write the output stream.
   --  ------------------------------
   procedure Open (Stream : in out File_Output_Stream;
                   Path   : in String;
                   Form   : in String := "") is
   begin
      if Ada.Wide_Wide_Text_IO.Is_Open (Stream.File) then
         Ada.Wide_Wide_Text_IO.Close (Stream.File);
      end if;
      Ada.Wide_Wide_Text_IO.Open (Stream.File, Ada.Wide_Wide_Text_IO.Out_File, Path, Form);
      Ada.Wide_Wide_Text_IO.Set_Line_Length (Ada.Wide_Wide_Text_IO.Count'Last);
      Stream.Stdout := False;
   end Open;

   --  ------------------------------
   --  Create the file and prepare to write the output stream.
   --  ------------------------------
   procedure Create (Stream : in out File_Output_Stream;
                     Path   : in String;
                     Form   : in String := "") is
   begin
      Ada.Wide_Wide_Text_IO.Create (Stream.File, Ada.Wide_Wide_Text_IO.Out_File, Path, Form);
      Ada.Wide_Wide_Text_IO.Set_Line_Length (Ada.Wide_Wide_Text_IO.Count'Last);
      Stream.Stdout := False;
   end Create;

   --  ------------------------------
   --  Close the file.
   --  ------------------------------
   procedure Close (Stream : in out File_Output_Stream) is
   begin
      if Ada.Wide_Wide_Text_IO.Is_Open (Stream.File) then
         Ada.Wide_Wide_Text_IO.Close (Stream.File);
      end if;
   end Close;

   --  ------------------------------
   --  Write the string to the output stream.
   --  ------------------------------
   overriding
   procedure Write (Stream  : in out File_Output_Stream;
                    Content : in Wiki.Strings.WString) is
   begin
      if not Stream.Stdout then
         Ada.Wide_Wide_Text_IO.Put (Stream.File, Content);
      else
         Ada.Wide_Wide_Text_IO.Put (Content);
      end if;
   end Write;

   --  ------------------------------
   --  Write a single character to the output stream.
   --  ------------------------------
   overriding
   procedure Write (Stream : in out File_Output_Stream;
                    Char   : in Wiki.Strings.WChar) is
   begin
      if not Stream.Stdout then
         Ada.Wide_Wide_Text_IO.Put (Stream.File, Char);
      else
         Ada.Wide_Wide_Text_IO.Put (Char);
      end if;
   end Write;

   --  ------------------------------
   --  Close the stream.
   --  ------------------------------
   overriding
   procedure Finalize (Stream : in out File_Output_Stream) is
   begin
      Stream.Close;
   end Finalize;

end Wiki.Streams.Text_IO;

-----------------------------------------------------------------------
--  wiki-streams-text_io -- Text_IO input output streams
--  Copyright (C) 2016, 2022 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.IO_Exceptions;

with Wiki.Helpers;
package body Wiki.Streams.Text_IO is

   --  ------------------------------
   --  Open the file and prepare to read the input stream.
   --  ------------------------------
   procedure Open (Stream : in out File_Input_Stream;
                   Path   : in String;
                   Form   : in String := "") is
   begin
      Ada.Wide_Wide_Text_IO.Open (Stream.File, Ada.Wide_Wide_Text_IO.In_File, Path, Form);
      Stream.Stdin := False;
   end Open;

   --  ------------------------------
   --  Close the file.
   --  ------------------------------
   procedure Close (Stream : in out File_Input_Stream) is
   begin
      if Ada.Wide_Wide_Text_IO.Is_Open (Stream.File) then
         Ada.Wide_Wide_Text_IO.Close (Stream.File);
      end if;
   end Close;

   --  ------------------------------
   --  Close the stream.
   --  ------------------------------
   overriding
   procedure Finalize (Stream : in out File_Input_Stream) is
   begin
      Stream.Close;
   end Finalize;

   --  ------------------------------
   --  Read the input stream and fill the `Into` buffer until either it is full or
   --  we reach the end of line.  Returns in `Last` the last valid position in the
   --  `Into` buffer.  When there is no character to read, return True in
   --  the `Eof` indicator.
   --  ------------------------------
   overriding
   procedure Read (Input : in out File_Input_Stream;
                   Into  : in out Wiki.Strings.WString;
                   Last  : out Natural;
                   Eof   : out Boolean) is
   begin
      if Input.Stdin then
         if not Ada.Wide_Wide_Text_IO.End_Of_File then
            Ada.Wide_Wide_Text_IO.Get_Line (Into, Last);
            if Last < Into'Last then
               Into (Last + 1) := Helpers.LF;
               Last := Last + 1;
            end if;
            Eof := False;
         else
            Last := Into'First - 1;
            Eof := True;
         end if;
      else
         if not Ada.Wide_Wide_Text_IO.End_Of_File (Input.File) then
            Ada.Wide_Wide_Text_IO.Get_Line (Input.File, Into, Last);
            if Last < Into'Last then
               Into (Last + 1) := Helpers.LF;
               Last := Last + 1;
            end if;
            Eof := False;
         else
            Last := Into'First - 1;
            Eof := True;
         end if;
      end if;

   exception
      when Ada.IO_Exceptions.End_Error =>
         Last := Into'First - 1;
         Eof  := True;

   end Read;

   --  ------------------------------
   --  Open the file and prepare to write the output stream.
   --  ------------------------------
   procedure Open (Stream : in out File_Output_Stream;
                   Path   : in String;
                   Form   : in String := "") is
   begin
      if Ada.Wide_Wide_Text_IO.Is_Open (Stream.File) then
         Ada.Wide_Wide_Text_IO.Close (Stream.File);
      end if;
      Ada.Wide_Wide_Text_IO.Open (Stream.File, Ada.Wide_Wide_Text_IO.Out_File, Path, Form);
      Ada.Wide_Wide_Text_IO.Set_Line_Length (Ada.Wide_Wide_Text_IO.Count'Last);
      Stream.Stdout := False;
   end Open;

   --  ------------------------------
   --  Create the file and prepare to write the output stream.
   --  ------------------------------
   procedure Create (Stream : in out File_Output_Stream;
                     Path   : in String;
                     Form   : in String := "") is
   begin
      Ada.Wide_Wide_Text_IO.Create (Stream.File, Ada.Wide_Wide_Text_IO.Out_File, Path, Form);
      Ada.Wide_Wide_Text_IO.Set_Line_Length (Ada.Wide_Wide_Text_IO.Count'Last);
      Stream.Stdout := False;
   end Create;

   --  ------------------------------
   --  Close the file.
   --  ------------------------------
   procedure Close (Stream : in out File_Output_Stream) is
   begin
      if Ada.Wide_Wide_Text_IO.Is_Open (Stream.File) then
         Ada.Wide_Wide_Text_IO.Close (Stream.File);
      end if;
   end Close;

   --  ------------------------------
   --  Write the string to the output stream.
   --  ------------------------------
   overriding
   procedure Write (Stream  : in out File_Output_Stream;
                    Content : in Wiki.Strings.WString) is
   begin
      if not Stream.Stdout then
         Ada.Wide_Wide_Text_IO.Put (Stream.File, Content);
      else
         Ada.Wide_Wide_Text_IO.Put (Content);
      end if;
   end Write;

   --  ------------------------------
   --  Write a single character to the output stream.
   --  ------------------------------
   overriding
   procedure Write (Stream : in out File_Output_Stream;
                    Char   : in Wiki.Strings.WChar) is
   begin
      if not Stream.Stdout then
         Ada.Wide_Wide_Text_IO.Put (Stream.File, Char);
      else
         Ada.Wide_Wide_Text_IO.Put (Char);
      end if;
   end Write;

   --  ------------------------------
   --  Close the stream.
   --  ------------------------------
   overriding
   procedure Finalize (Stream : in out File_Output_Stream) is
   begin
      Stream.Close;
   end Finalize;

end Wiki.Streams.Text_IO;

Fix compilation warnings: remove unused local variables


-----------------------------------------------------------------------
--  mat-expressions-tests -- Unit tests for MAT expressions
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Directories;
with Util.Test_Caller;
with Util.Assertions;

package body MAT.Expressions.Tests is

   use Util.Tests;

   package Caller is new Util.Test_Caller (Test, "Expressions");

   procedure Assert_Equals_Kind is
     new Util.Assertions.Assert_Equals_T (Value_Type => Kind_Type);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test MAT.Expressions.Parse",
                       Test_Parse_Expression'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test parsing simple expressions
   --  ------------------------------
   procedure Test_Parse_Expression (T : in out Test) is
      Result : MAT.Expressions.Expression_Type;
   begin
      Result := MAT.Expressions.Parse ("by foo", null);
      T.Assert (Result.Node /= null, "Parse 'by foo' must return a expression");
      Assert_Equals_Kind (T, N_INSIDE, Result.Node.Kind, "Invalid node kind");

      Result := MAT.Expressions.Parse ("by direct foo", null);
      T.Assert (Result.Node /= null, "Parse 'by direct foo' must return a expression");
      Assert_Equals_Kind (T, N_INSIDE, Result.Node.Kind, "Invalid node kind");

      Result := MAT.Expressions.Parse ("after foo", null);
      T.Assert (Result.Node /= null, "Parse 'after foo' must return a expression");
--        Assert_Equals_Kind (T, N_INSIDE, Result.Node.Kind, "Invalid node kind");

      Result := MAT.Expressions.Parse ("before foo", null);
      T.Assert (Result.Node /= null, "Parse 'before foo' must return a expression");
      --        Assert_Equals_Kind (T, N_INSIDE, Result.Node.Kind, "Invalid node kind");

      Result := MAT.Expressions.Parse ("with size in [10,100]", null);
      T.Assert (Result.Node /= null, "Parse 'by direct foo' must return a expression");
      Assert_Equals_Kind (T, N_RANGE_SIZE, Result.Node.Kind, "Invalid node kind");

      Result := MAT.Expressions.Parse ("with size in [10..100]", null);
      T.Assert (Result.Node /= null, "Parse 'by direct foo' must return a expression");
      Assert_Equals_Kind (T, N_RANGE_SIZE, Result.Node.Kind, "Invalid node kind");

   end Test_Parse_Expression;

end MAT.Expressions.Tests;

-----------------------------------------------------------------------
--  mat-expressions-tests -- Unit tests for MAT expressions
--  Copyright (C) 2014, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Directories;
with Util.Test_Caller;
with Util.Assertions;

package body MAT.Expressions.Tests is

   use Util.Tests;

   package Caller is new Util.Test_Caller (Test, "Expressions");

   procedure Assert_Equals_Kind is
     new Util.Assertions.Assert_Equals_T (Value_Type => Kind_Type);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test MAT.Expressions.Parse",
                       Test_Parse_Expression'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test parsing simple expressions
   --  ------------------------------
   procedure Test_Parse_Expression (T : in out Test) is
      Result : MAT.Expressions.Expression_Type;
   begin
      Result := MAT.Expressions.Parse ("by foo", null);
      T.Assert (Result.Node /= null, "Parse 'by foo' must return a expression");
      Assert_Equals_Kind (T, N_IN_FUNC, Result.Node.Kind, "Invalid node kind");

      Result := MAT.Expressions.Parse ("by direct foo", null);
      T.Assert (Result.Node /= null, "Parse 'by direct foo' must return a expression");
      Assert_Equals_Kind (T, N_IN_FUNC_DIRECT, Result.Node.Kind, "Invalid node kind");

      Result := MAT.Expressions.Parse ("after foo", null);
      T.Assert (Result.Node /= null, "Parse 'after foo' must return a expression");
--        Assert_Equals_Kind (T, N_INSIDE, Result.Node.Kind, "Invalid node kind");

      Result := MAT.Expressions.Parse ("before foo", null);
      T.Assert (Result.Node /= null, "Parse 'before foo' must return a expression");
      --        Assert_Equals_Kind (T, N_INSIDE, Result.Node.Kind, "Invalid node kind");

      Result := MAT.Expressions.Parse ("size = 10", null);
      T.Assert (Result.Node /= null, "Parse 'size = 10' must return a expression");
      Assert_Equals_Kind (T, N_RANGE_SIZE, Result.Node.Kind, "Invalid node kind");

      Result := MAT.Expressions.Parse ("size > 10", null);
      T.Assert (Result.Node /= null, "Parse 'size > 10' must return a expression");
      Assert_Equals_Kind (T, N_RANGE_SIZE, Result.Node.Kind, "Invalid node kind");

      Result := MAT.Expressions.Parse ("size < 10", null);
      T.Assert (Result.Node /= null, "Parse 'size < 10' must return a expression");
      Assert_Equals_Kind (T, N_RANGE_SIZE, Result.Node.Kind, "Invalid node kind");

      Result := MAT.Expressions.Parse ("event = 23", null);
      T.Assert (Result.Node /= null, "Parse 'event = 23' must return a expression");
      Assert_Equals_Kind (T, N_EVENT, Result.Node.Kind, "Invalid node kind");

      Result := MAT.Expressions.Parse ("event = 1..100", null);
      T.Assert (Result.Node /= null, "Parse 'event = 1..100' must return a expression");
      Assert_Equals_Kind (T, N_EVENT, Result.Node.Kind, "Invalid node kind");

   end Test_Parse_Expression;

end MAT.Expressions.Tests;

Add some unit tests for expressions

Add some unit tests for expressions