-----------------------------------------------------------------------
--  wiki-parsers-html -- Wiki HTML parser
--  Copyright (C) 2015, 2016 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 Wiki.Helpers;
with Wiki.Parsers.Html.Entities;
package body Wiki.Parsers.Html is

   --  Parse an HTML attribute
   procedure Parse_Attribute_Name (P    : in out Parser;
                                   Name : in out Wiki.Strings.BString);

   --  Parse a HTML/XML comment to strip it.
   procedure Parse_Comment (P : in out Parser);

   --  Parse a simple DOCTYPE declaration and ignore it.
   procedure Parse_Doctype (P : in out Parser);

   procedure Collect_Attributes (P     : in out Parser);
   function Is_Letter (C : in Wiki.Strings.WChar) return Boolean;
   procedure Collect_Attribute_Value (P     : in out Parser;
                                      Value : in out Wiki.Strings.BString);

   function Is_Letter (C : in Wiki.Strings.WChar) return Boolean is
   begin
      return C > ' ' and C /= ':' and C /= '>' and C /= ''' and C /= '"'
        and C /= '/' and C /= '=' and C /= '<';
   end Is_Letter;

   --  ------------------------------
   --  Parse an HTML attribute
   --  ------------------------------
   procedure Parse_Attribute_Name (P    : in out Parser;
                                   Name : in out Wiki.Strings.BString) is
      C : Wiki.Strings.WChar;
   begin
      Skip_Spaces (P);
      while not P.Is_Eof loop
         Peek (P, C);
         if not Is_Letter (C) then
            Put_Back (P, C);
            return;
         end if;
         Wiki.Strings.Wide_Wide_Builders.Append (Name, C);
      end loop;
   end Parse_Attribute_Name;

   procedure Collect_Attribute_Value (P     : in out Parser;
                                      Value : in out Wiki.Strings.BString) is
      C     : Wiki.Strings.WChar;
      Token : Wiki.Strings.WChar;
   begin
--      Value := Wiki.Strings.To_UString ("");
      Peek (P, Token);
      if Wiki.Helpers.Is_Space (Token) then
         return;
      elsif Token = '>' then
         Put_Back (P, Token);
         return;
      elsif Token /= ''' and Token /= '"' then
         Wiki.Strings.Wide_Wide_Builders.Append (Value, Token);
         while not P.Is_Eof loop
            Peek (P, C);
            if C = ''' or C = '"' or C = ' ' or C = '=' or C = '>' or C = '<' or C = '`' then
               Put_Back (P, C);
               return;
            end if;
            Wiki.Strings.Wide_Wide_Builders.Append (Value, C);
         end loop;
      else
         while not P.Is_Eof loop
            Peek (P, C);
            if C = Token then
               return;
            end if;
            Wiki.Strings.Wide_Wide_Builders.Append (Value, C);
         end loop;
      end if;
   end Collect_Attribute_Value;

   --  ------------------------------
   --  Parse a list of HTML attributes up to the first '>'.
   --  attr-name
   --  attr-name=
   --  attr-name=value
   --  attr-name='value'
   --  attr-name="value"
   --  <name name='value' ...>
   --  ------------------------------
   procedure Collect_Attributes (P     : in out Parser) is
      procedure Append_Attribute (Name : in Wiki.Strings.WString);

      C     : Wiki.Strings.WChar;
      Name  : Wiki.Strings.BString (64);
      Value : Wiki.Strings.BString (256);

      procedure Append_Attribute (Name : in Wiki.Strings.WString) is

         procedure Attribute_Value (Value : in Wiki.Strings.WString);

         procedure Attribute_Value (Value : in Wiki.Strings.WString) is
         begin
            Attributes.Append (P.Attributes, Name, Value);
         end Attribute_Value;

         procedure Attribute_Value is
           new Wiki.Strings.Wide_Wide_Builders.Get (Attribute_Value);
         pragma Inline (Attribute_Value);

      begin
         Attribute_Value (Value);
      end Append_Attribute;
      pragma Inline (Append_Attribute);

      procedure Append_Attribute is
        new Wiki.Strings.Wide_Wide_Builders.Get (Append_Attribute);

   begin
      Wiki.Attributes.Clear (P.Attributes);
      while not P.Is_Eof loop
         Parse_Attribute_Name (P, Name);
         Skip_Spaces (P);
         Peek (P, C);
         if C = '>' or C = '<' or C = '/' then
            Put_Back (P, C);
            exit;
         end if;
         if C = '=' then
            Collect_Attribute_Value (P, Value);
            Append_Attribute (Name);
            Wiki.Strings.Wide_Wide_Builders.Clear (Name);
            Wiki.Strings.Wide_Wide_Builders.Clear (Value);
         elsif Wiki.Strings.Wide_Wide_Builders.Length (Name) > 0 then
            Put_Back (P, C);
            Append_Attribute (Name);
            Wiki.Strings.Wide_Wide_Builders.Clear (Name);
         end if;
      end loop;

      --  Add any pending attribute.
      if Wiki.Strings.Wide_Wide_Builders.Length (Name) > 0 then
         Append_Attribute (Name);
      end if;
   end Collect_Attributes;

   --  ------------------------------
   --  Parse a HTML/XML comment to strip it.
   --  ------------------------------
   procedure Parse_Comment (P : in out Parser) is
      C     : Wiki.Strings.WChar;
   begin
      Peek (P, C);
      while not P.Is_Eof loop
         Peek (P, C);
         if C = '-' then
            declare
               Count : Natural := 1;
            begin
               Peek (P, C);
               while not P.Is_Eof and C = '-' loop
                  Peek (P, C);
                  Count := Count + 1;
               end loop;
               exit when C = '>' and Count >= 2;
            end;
         end if;
      end loop;
   end Parse_Comment;

   --  ------------------------------
   --  Parse a simple DOCTYPE declaration and ignore it.
   --  ------------------------------
   procedure Parse_Doctype (P : in out Parser) is
      C : Wiki.Strings.WChar;
   begin
      while not P.Is_Eof loop
         Peek (P, C);
         exit when C = '>';
      end loop;
   end Parse_Doctype;

   --  ------------------------------
   --  Parse a HTML element <XXX attributes>
   --  or parse an end of HTML element </XXX>
   --  ------------------------------
   procedure Parse_Element (P : in out Parser) is
      C    : Wiki.Strings.WChar;

      procedure Add_Element (Token : in Wiki.Strings.WString);

      procedure Add_Element (Token : in Wiki.Strings.WString) is
         Tag  : Wiki.Html_Tag;
      begin
         Tag := Wiki.Find_Tag (Token);
         if C = '/' then
            Skip_Spaces (P);
            Peek (P, C);
            if C /= '>' then
               Put_Back (P, C);
            end if;
            Flush_Text (P);
            if Tag = Wiki.UNKNOWN_TAG then
               if Token = "noinclude" then
                  P.Is_Hidden := False;
               end if;
            else
               End_Element (P, Tag);
            end if;
         else
            Collect_Attributes (P);
            Peek (P, C);
            if C = '/' then
               Peek (P, C);
               if C = '>' then
                  Start_Element (P, Tag, P.Attributes);
                  End_Element (P, Tag);
                  return;
               end if;
            elsif C /= '>' then
               Put_Back (P, C);
            end if;
            if Tag = UNKNOWN_TAG then
               if Token = "noinclude" then
                  P.Is_Hidden := True;
               end if;
            else
               Start_Element (P, Tag, P.Attributes);
            end if;
         end if;
      end Add_Element;
      pragma Inline_Always (Add_Element);

      procedure Add_Element is
        new Wiki.Strings.Wide_Wide_Builders.Get (Add_Element);
      pragma Inline_Always (Add_Element);

      Name : Wiki.Strings.BString (64);
   begin
      Peek (P, C);
      if C = '!' then
         Peek (P, C);
         if C = '-' then
            Parse_Comment (P);
         else
            Parse_Doctype (P);
         end if;
         return;
      end if;
      if C /= '/' then
         Put_Back (P, C);
      end if;
      Parse_Attribute_Name (P, Name);
      Add_Element (Name);
   end Parse_Element;

   --  ------------------------------
   --  Parse an HTML entity such as   and replace it with the corresponding code.
   --  ------------------------------
   procedure Parse_Entity (P     : in out Parser;
                           Token : in Wiki.Strings.WChar) is
      pragma Unreferenced (Token);

      Name : String (1 .. 10);
      Len  : Natural := 0;
      High : Natural := Wiki.Parsers.Html.Entities.Keywords'Last;
      Low  : Natural := Wiki.Parsers.Html.Entities.Keywords'First;
      Pos  : Natural;
      C    : Wiki.Strings.WChar;
   begin
      while Len < Name'Last loop
         Peek (P, C);
         exit when C = ';' or else P.Is_Eof;
         Len := Len + 1;
         Name (Len) := Wiki.Strings.To_Char (C);
      end loop;
      while Low <= High loop
         Pos := (Low + High) / 2;
         if Wiki.Parsers.Html.Entities.Keywords (Pos).all = Name (1 .. Len) then
            Parse_Text (P, Entities.Mapping (Pos));
            return;
         elsif Entities.Keywords (Pos).all < Name (1 .. Len) then
            Low := Pos + 1;
         else
            High := Pos - 1;
         end if;
      end loop;

      --  The HTML entity is not recognized: we must treat it as plain wiki text.
      Parse_Text (P, '&');
      for I in 1 .. Len loop
         Parse_Text (P, Wiki.Strings.To_WChar (Name (I)));
      end loop;
   end Parse_Entity;

end Wiki.Parsers.Html;

-----------------------------------------------------------------------
--  wiki-parsers-html -- Wiki HTML parser
--  Copyright (C) 2015, 2016 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 Wiki.Helpers;
with Wiki.Parsers.Html.Entities;
package body Wiki.Parsers.Html is

   --  Parse an HTML attribute
   procedure Parse_Attribute_Name (P    : in out Parser;
                                   Name : in out Wiki.Strings.BString);

   --  Parse a HTML/XML comment to strip it.
   procedure Parse_Comment (P : in out Parser);

   --  Parse a simple DOCTYPE declaration and ignore it.
   procedure Parse_Doctype (P : in out Parser);

   procedure Collect_Attributes (P     : in out Parser);
   function Is_Letter (C : in Wiki.Strings.WChar) return Boolean;
   procedure Collect_Attribute_Value (P     : in out Parser;
                                      Value : in out Wiki.Strings.BString);

   function Is_Letter (C : in Wiki.Strings.WChar) return Boolean is
   begin
      return C > ' ' and C /= ':' and C /= '>' and C /= ''' and C /= '"'
        and C /= '/' and C /= '=' and C /= '<';
   end Is_Letter;

   --  ------------------------------
   --  Parse an HTML attribute
   --  ------------------------------
   procedure Parse_Attribute_Name (P    : in out Parser;
                                   Name : in out Wiki.Strings.BString) is
      C : Wiki.Strings.WChar;
   begin
      Skip_Spaces (P);
      while not P.Is_Eof loop
         Peek (P, C);
         if not Is_Letter (C) then
            Put_Back (P, C);
            return;
         end if;
         Wiki.Strings.Wide_Wide_Builders.Append (Name, C);
      end loop;
   end Parse_Attribute_Name;

   procedure Collect_Attribute_Value (P     : in out Parser;
                                      Value : in out Wiki.Strings.BString) is
      C     : Wiki.Strings.WChar;
      Token : Wiki.Strings.WChar;
   begin
--      Value := Wiki.Strings.To_UString ("");
      Peek (P, Token);
      if Wiki.Helpers.Is_Space (Token) then
         return;
      elsif Token = '>' then
         Put_Back (P, Token);
         return;
      elsif Token /= ''' and Token /= '"' then
         Wiki.Strings.Wide_Wide_Builders.Append (Value, Token);
         while not P.Is_Eof loop
            Peek (P, C);
            if C = ''' or C = '"' or C = ' ' or C = '=' or C = '>' or C = '<' or C = '`' then
               Put_Back (P, C);
               return;
            end if;
            Wiki.Strings.Wide_Wide_Builders.Append (Value, C);
         end loop;
      else
         while not P.Is_Eof loop
            Peek (P, C);
            if C = Token then
               return;
            end if;
            Wiki.Strings.Wide_Wide_Builders.Append (Value, C);
         end loop;
      end if;
   end Collect_Attribute_Value;

   --  ------------------------------
   --  Parse a list of HTML attributes up to the first '>'.
   --  attr-name
   --  attr-name=
   --  attr-name=value
   --  attr-name='value'
   --  attr-name="value"
   --  <name name='value' ...>
   --  ------------------------------
   procedure Collect_Attributes (P     : in out Parser) is
      procedure Append_Attribute (Name : in Wiki.Strings.WString);

      C     : Wiki.Strings.WChar;
      Name  : Wiki.Strings.BString (64);
      Value : Wiki.Strings.BString (256);

      procedure Append_Attribute (Name : in Wiki.Strings.WString) is

         procedure Attribute_Value (Value : in Wiki.Strings.WString);

         procedure Attribute_Value (Value : in Wiki.Strings.WString) is
         begin
            Attributes.Append (P.Attributes, Name, Value);
         end Attribute_Value;

         procedure Attribute_Value is
           new Wiki.Strings.Wide_Wide_Builders.Get (Attribute_Value);
         pragma Inline (Attribute_Value);

      begin
         Attribute_Value (Value);
      end Append_Attribute;
      pragma Inline (Append_Attribute);

      procedure Append_Attribute is
        new Wiki.Strings.Wide_Wide_Builders.Get (Append_Attribute);

   begin
      Wiki.Attributes.Clear (P.Attributes);
      while not P.Is_Eof loop
         Parse_Attribute_Name (P, Name);
         Skip_Spaces (P);
         Peek (P, C);
         if C = '>' or C = '<' or C = '/' then
            Put_Back (P, C);
            exit;
         end if;
         if C = '=' then
            Collect_Attribute_Value (P, Value);
            Append_Attribute (Name);
            Wiki.Strings.Wide_Wide_Builders.Clear (Name);
            Wiki.Strings.Wide_Wide_Builders.Clear (Value);
         elsif Wiki.Strings.Wide_Wide_Builders.Length (Name) > 0 then
            Put_Back (P, C);
            Append_Attribute (Name);
            Wiki.Strings.Wide_Wide_Builders.Clear (Name);
         end if;
      end loop;

      --  Add any pending attribute.
      if Wiki.Strings.Wide_Wide_Builders.Length (Name) > 0 then
         Append_Attribute (Name);
      end if;
   end Collect_Attributes;

   --  ------------------------------
   --  Parse a HTML/XML comment to strip it.
   --  ------------------------------
   procedure Parse_Comment (P : in out Parser) is
      C     : Wiki.Strings.WChar;
   begin
      Peek (P, C);
      while not P.Is_Eof loop
         Peek (P, C);
         if C = '-' then
            declare
               Count : Natural := 1;
            begin
               Peek (P, C);
               while not P.Is_Eof and C = '-' loop
                  Peek (P, C);
                  Count := Count + 1;
               end loop;
               exit when C = '>' and Count >= 2;
            end;
         end if;
      end loop;
   end Parse_Comment;

   --  ------------------------------
   --  Parse a simple DOCTYPE declaration and ignore it.
   --  ------------------------------
   procedure Parse_Doctype (P : in out Parser) is
      C : Wiki.Strings.WChar;
   begin
      while not P.Is_Eof loop
         Peek (P, C);
         exit when C = '>';
      end loop;
   end Parse_Doctype;

   --  ------------------------------
   --  Parse a HTML element <XXX attributes>
   --  or parse an end of HTML element </XXX>
   --  ------------------------------
   procedure Parse_Element (P : in out Parser) is
      C    : Wiki.Strings.WChar;

      procedure Add_Element (Token : in Wiki.Strings.WString);

      procedure Add_Element (Token : in Wiki.Strings.WString) is
         Tag  : Wiki.Html_Tag;
      begin
         Tag := Wiki.Find_Tag (Token);
         if C = '/' then
            Skip_Spaces (P);
            Peek (P, C);
            if C /= '>' then
               Put_Back (P, C);
            end if;
            Flush_Text (P);
            if Tag = Wiki.UNKNOWN_TAG then
               if Token = "noinclude" then
                  P.Is_Hidden := False;
               end if;
            else
               End_Element (P, Tag);
            end if;
         else
            Collect_Attributes (P);
            Peek (P, C);
            if C = '/' then
               Peek (P, C);
               if C = '>' then
                  Start_Element (P, Tag, P.Attributes);
                  End_Element (P, Tag);
                  return;
               end if;
            elsif C /= '>' then
               Put_Back (P, C);
            end if;
            if Tag = UNKNOWN_TAG then
               if Token = "noinclude" then
                  P.Is_Hidden := True;
               end if;
            else
               Start_Element (P, Tag, P.Attributes);
            end if;
         end if;
      end Add_Element;
      pragma Inline (Add_Element);

      procedure Add_Element is
        new Wiki.Strings.Wide_Wide_Builders.Get (Add_Element);
      pragma Inline (Add_Element);

      Name : Wiki.Strings.BString (64);
   begin
      Peek (P, C);
      if C = '!' then
         Peek (P, C);
         if C = '-' then
            Parse_Comment (P);
         else
            Parse_Doctype (P);
         end if;
         return;
      end if;
      if C /= '/' then
         Put_Back (P, C);
      end if;
      Parse_Attribute_Name (P, Name);
      Add_Element (Name);
   end Parse_Element;

   --  ------------------------------
   --  Parse an HTML entity such as   and replace it with the corresponding code.
   --  ------------------------------
   procedure Parse_Entity (P     : in out Parser;
                           Token : in Wiki.Strings.WChar) is
      pragma Unreferenced (Token);

      Name : String (1 .. 10);
      Len  : Natural := 0;
      High : Natural := Wiki.Parsers.Html.Entities.Keywords'Last;
      Low  : Natural := Wiki.Parsers.Html.Entities.Keywords'First;
      Pos  : Natural;
      C    : Wiki.Strings.WChar;
   begin
      while Len < Name'Last loop
         Peek (P, C);
         exit when C = ';' or else P.Is_Eof;
         Len := Len + 1;
         Name (Len) := Wiki.Strings.To_Char (C);
      end loop;
      while Low <= High loop
         Pos := (Low + High) / 2;
         if Wiki.Parsers.Html.Entities.Keywords (Pos).all = Name (1 .. Len) then
            Parse_Text (P, Entities.Mapping (Pos));
            return;
         elsif Entities.Keywords (Pos).all < Name (1 .. Len) then
            Low := Pos + 1;
         else
            High := Pos - 1;
         end if;
      end loop;

      --  The HTML entity is not recognized: we must treat it as plain wiki text.
      Parse_Text (P, '&');
      for I in 1 .. Len loop
         Parse_Text (P, Wiki.Strings.To_WChar (Name (I)));
      end loop;
   end Parse_Entity;

end Wiki.Parsers.Html;

Change pragma Inline_Always to Inline for old compiler


-----------------------------------------------------------------------
--  mat-events-targets - Events received and collected from a target
--  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.
-----------------------------------------------------------------------

package body MAT.Events.Targets is

   --  ------------------------------
   --  Add the event in the list of events and increment the event counter.
   --  ------------------------------
   procedure Insert (Target : in out Target_Events;
                     Event  : in Probe_Event_Type) is
   begin
      Target.Events.Insert (Event);
      Util.Concurrent.Counters.Increment (Target.Event_Count);
   end Insert;

   procedure Get_Events (Target : in out Target_Events;
                         Start  : in MAT.Types.Target_Time;
                         Finish : in MAT.Types.Target_Time;
                         Into   : in out Target_Event_Vector) is
   begin
      Target.Events.Get_Events (Start, Finish, Into);
   end Get_Events;

   --  ------------------------------
   --  Get the start and finish time for the events that have been received.
   --  ------------------------------
   procedure Get_Time_Range (Target : in out Target_Events;
                             Start  : out MAT.Types.Target_Time;
                             Finish : out MAT.Types.Target_Time) is
   begin
      Target.Events.Get_Time_Range (Start, Finish);
   end Get_Time_Range;

   --  ------------------------------
   --  Get the probe event with the given allocated unique id.
   --  ------------------------------
   function Get_Event (Target : in Target_Events;
                       Id     : in Event_Id_Type) return Probe_Event_Type is
   begin
      return Target.Events.Get_Event (Id);
   end Get_Event;

   --  ------------------------------
   --  Get the current event counter.
   --  ------------------------------
   function Get_Event_Counter (Target : in Target_Events) return Integer is
   begin
      return Util.Concurrent.Counters.Value (Target.Event_Count);
   end Get_Event_Counter;

   protected body Event_Collector is

      --  ------------------------------
      --  Add the event in the list of events.
      --  ------------------------------
      procedure Insert (Event : in Probe_Event_Type) is
         Info : Target_Event;
      begin
         if Current = null then
            Current := new Event_Block;
            Current.Start := Event.Time;
            Events.Insert (Event.Time, Current);
            Ids.Insert (Last_Id + 1, Current);
         end if;
         Current.Count := Current.Count + 1;
         Current.Events (Current.Count) := Event;
         Current.Events (Current.Count).Id := Last_Id;
         Last_Id := Last_Id + 1;
         Current.Finish := Event.Time;
         if Current.Count = Current.Events'Last then
            Current := null;
         end if;
      end Insert;

      procedure Get_Events (Start  : in MAT.Types.Target_Time;
                            Finish : in MAT.Types.Target_Time;
                            Into   : in out Target_Event_Vector) is
         Iter  : Event_Cursor := Events.Floor (Start);
         Block : Event_Block_Access;
      begin
         while Event_Maps.Has_Element (Iter) loop
            Block := Event_Maps.Element (Iter);
            exit when Block.Start > Finish;
            for I in Block.Events'First .. Block.Count loop
               exit when Block.Events (I).Time > Finish;
               if Block.Events (I).Time >= Start then
                  Into.Append (Block.Events (I));
               end if;
            end loop;
            Event_Maps.Next (Iter);
         end loop;
      end Get_Events;

      --  ------------------------------
      --  Get the start and finish time for the events that have been received.
      --  ------------------------------
      procedure Get_Time_Range (Start  : out MAT.Types.Target_Time;
                                Finish : out MAT.Types.Target_Time) is
         First : constant Event_Block_Access := Events.First_Element;
         Last  : constant Event_Block_Access := Events.Last_Element;
      begin
         Start  := First.Events (First.Events'First).Time;
         Finish := Last.Events (Last.Count).Time;
      end Get_Time_Range;

      --  ------------------------------
      --  Get the probe event with the given allocated unique id.
      --  ------------------------------
      function Get_Event (Id : in Event_Id_Type) return Probe_Event_Type is
         Iter  : Event_Id_Cursor := Ids.Floor (Id);
         Block : Event_Block_Access;
         Pos   : Event_Id_Type;
      begin
         while not Event_Id_Maps.Has_Element (Iter) loop
            Block := Event_Id_Maps.Element (Iter);
            exit when Id < Block.Events (Block.Events'First).Id;
            Pos := Id - Block.Events (Block.Events'First).Id;
            if Pos < Block.Count then
               return Block.Events (Pos);
            end if;
            Event_Id_Maps.Next (Iter);
         end loop;
         raise Not_Found;
      end Get_Event;

   end Event_Collector;

end MAT.Events.Targets;

-----------------------------------------------------------------------
--  mat-events-targets - Events received and collected from a target
--  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.
-----------------------------------------------------------------------

package body MAT.Events.Targets is

   --  ------------------------------
   --  Add the event in the list of events and increment the event counter.
   --  ------------------------------
   procedure Insert (Target : in out Target_Events;
                     Event  : in Probe_Event_Type) is
   begin
      Target.Events.Insert (Event);
      Util.Concurrent.Counters.Increment (Target.Event_Count);
   end Insert;

   procedure Get_Events (Target : in out Target_Events;
                         Start  : in MAT.Types.Target_Time;
                         Finish : in MAT.Types.Target_Time;
                         Into   : in out Target_Event_Vector) is
   begin
      Target.Events.Get_Events (Start, Finish, Into);
   end Get_Events;

   --  ------------------------------
   --  Get the start and finish time for the events that have been received.
   --  ------------------------------
   procedure Get_Time_Range (Target : in out Target_Events;
                             Start  : out MAT.Types.Target_Time;
                             Finish : out MAT.Types.Target_Time) is
   begin
      Target.Events.Get_Time_Range (Start, Finish);
   end Get_Time_Range;

   --  ------------------------------
   --  Get the probe event with the given allocated unique id.
   --  ------------------------------
   function Get_Event (Target : in Target_Events;
                       Id     : in Event_Id_Type) return Probe_Event_Type is
   begin
      return Target.Events.Get_Event (Id);
   end Get_Event;

   --  ------------------------------
   --  Get the current event counter.
   --  ------------------------------
   function Get_Event_Counter (Target : in Target_Events) return Integer is
   begin
      return Util.Concurrent.Counters.Value (Target.Event_Count);
   end Get_Event_Counter;

   protected body Event_Collector is

      --  ------------------------------
      --  Add the event in the list of events.
      --  ------------------------------
      procedure Insert (Event : in Probe_Event_Type) is
         Info : Target_Event;
      begin
         if Current = null then
            Current := new Event_Block;
            Current.Start := Event.Time;
            Events.Insert (Event.Time, Current);
            Ids.Insert (Last_Id + 1, Current);
         end if;
         Current.Count := Current.Count + 1;
         Current.Events (Current.Count) := Event;
         Current.Events (Current.Count).Id := Last_Id;
         Last_Id := Last_Id + 1;
         Current.Finish := Event.Time;
         if Current.Count = Current.Events'Last then
            Current := null;
         end if;
      end Insert;

      procedure Get_Events (Start  : in MAT.Types.Target_Time;
                            Finish : in MAT.Types.Target_Time;
                            Into   : in out Target_Event_Vector) is
         Iter  : Event_Cursor := Events.Floor (Start);
         Block : Event_Block_Access;
      begin
         while Event_Maps.Has_Element (Iter) loop
            Block := Event_Maps.Element (Iter);
            exit when Block.Start > Finish;
            for I in Block.Events'First .. Block.Count loop
               exit when Block.Events (I).Time > Finish;
               if Block.Events (I).Time >= Start then
                  Into.Append (Block.Events (I));
               end if;
            end loop;
            Event_Maps.Next (Iter);
         end loop;
      end Get_Events;

      --  ------------------------------
      --  Get the start and finish time for the events that have been received.
      --  ------------------------------
      procedure Get_Time_Range (Start  : out MAT.Types.Target_Time;
                                Finish : out MAT.Types.Target_Time) is
         First : constant Event_Block_Access := Events.First_Element;
         Last  : constant Event_Block_Access := Events.Last_Element;
      begin
         Start  := First.Events (First.Events'First).Time;
         Finish := Last.Events (Last.Count).Time;
      end Get_Time_Range;

      --  ------------------------------
      --  Get the probe event with the given allocated unique id.
      --  ------------------------------
      function Get_Event (Id : in Event_Id_Type) return Probe_Event_Type is
         Iter  : Event_Id_Cursor := Ids.Floor (Id);
         Block : Event_Block_Access;
         Pos   : Event_Id_Type;
      begin
         while Event_Id_Maps.Has_Element (Iter) loop
            Block := Event_Id_Maps.Element (Iter);
            exit when Id < Block.Events (Block.Events'First).Id;
            Pos := Id - Block.Events (Block.Events'First).Id;
            if Pos < Block.Count then
               return Block.Events (Pos);
            end if;
            Event_Id_Maps.Next (Iter);
         end loop;
         raise Not_Found;
      end Get_Event;

   end Event_Collector;

end MAT.Events.Targets;

Fix the Get_Event procedure

Fix the Get_Event procedure


-----------------------------------------------------------------------
--  awa-questions-services-tests -- Unit tests for question service
--  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 Util.Tests;
with AWA.Tests;

package AWA.Questions.Services.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new AWA.Tests.Test with record
      Manager : AWA.Questions.Services.Question_Service_Access;
   end record;

   --  Test creation of a question.
   procedure Test_Create_Question (T : in out Test);

   --  Test list of questions.
   procedure Test_List_Questions (T : in out Test);

end AWA.Questions.Services.Tests;

-----------------------------------------------------------------------
--  awa-questions-services-tests -- Unit tests for question service
--  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 Util.Tests;
with AWA.Tests;

package AWA.Questions.Services.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new AWA.Tests.Test with record
      Manager : AWA.Questions.Services.Question_Service_Access;
   end record;

   --  Test creation of a question.
   procedure Test_Create_Question (T : in out Test);

   --  Test list of questions.
   procedure Test_List_Questions (T : in out Test);

   --  Test anonymous user voting for a question.
   procedure Test_Question_Vote_Anonymous (T : in out Test);

   --  Test voting for a question.
   procedure Test_Question_Vote (T : in out Test);

private

   --  Do a vote on a question through the question vote bean.
   procedure Do_Vote (T : in out Test);

end AWA.Questions.Services.Tests;

Add unit tests for the questionVote bean


-----------------------------------------------------------------------
--  atlas-server -- Application server
--  Copyright (C) 2011, 2012, 2013, 2016, 2017, 2018, 2019 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.Exceptions;

with Util.Log.Loggers;

with ADO.Drivers;
with AWS.Net.SSL;
with AWS.Config.Set;
with ASF.Server.Web;
with AWA.Setup.Applications;

with Atlas.Applications;
procedure Atlas.Server is

   procedure Configure (Config : in out AWS.Config.Object);

   Log     : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Atlas.Server");
   App     : constant Atlas.Applications.Application_Access := new Atlas.Applications.Application;
   WS      : ASF.Server.Web.AWS_Container;

   procedure Setup is
     new AWA.Setup.Applications.Configure (Atlas.Applications.Application'Class,
                                           Atlas.Applications.Application_Access,
                                           Atlas.Applications.Initialize);

   procedure Configure (Config : in out AWS.Config.Object) is
   begin
      AWS.Config.Set.Input_Line_Size_Limit (1_000_000);
      AWS.Config.Set.Max_Connection (Config, 2);
      AWS.Config.Set.Accept_Queue_Size (Config, 100);
      AWS.Config.Set.Send_Buffer_Size (Config, 128 * 1024);
      AWS.Config.Set.Upload_Size_Limit (Config, 100_000_000);
   end Configure;

begin
   ADO.Drivers.Initialize;
   WS.Configure (Configure'Access);
   WS.Start;
   Log.Info ("Connect you browser to: http://localhost:8080{0}/index.html",
             Atlas.Applications.CONTEXT_PATH);
   Setup (WS, App, "atlas", Atlas.Applications.CONTEXT_PATH);
   if not AWS.Net.SSL.Is_Supported then
      Log.Error ("SSL is not supported by AWS.");
      Log.Error ("SSL is required for the OAuth2/OpenID connector to "
                 & "connect to OAuth2/OpenID providers.");
      Log.Error ("Please, rebuild AWS with SSL support.");
   end if;
   delay 365.0 * 24.0 * 3600.0;
   App.Close;
exception
   when E : others =>
      Log.Error ("Exception in server: " &
                 Ada.Exceptions.Exception_Name (E) & ": " &
                 Ada.Exceptions.Exception_Message (E));
end Atlas.Server;

-----------------------------------------------------------------------
--  atlas-server -- Application server
--  Copyright (C) 2011, 2012, 2013, 2016, 2017, 2018, 2019, 2020 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.Exceptions;

with Util.Log.Loggers;
with Util.Commands;

with ADO.Drivers;
with AWS.Net.SSL;
with AWS.Config.Set;
with Servlet.Server.Web;
with AWA.Setup.Applications;
with AWA.Commands.Drivers;
with AWA.Commands.Start;
with AWA.Commands.Setup;
with AWA.Commands.Stop;
with AWA.Commands.List;

with Atlas.Applications;
procedure Atlas.Server is

   package Server_Commands is
     new AWA.Commands.Drivers (Driver_Name => "atlas",
                               Container_Type => Servlet.Server.Web.AWS_Container);

   package List_Command is
      new AWA.Commands.List (Server_Commands);

   package Start_Command is
      new AWA.Commands.Start (Server_Commands);

   package Stop_Command is
      new AWA.Commands.Stop (Server_Commands);

   package Setup_Command is
      new AWA.Commands.Setup (Start_Command);

   procedure Configure (Config : in out AWS.Config.Object);

   Log     : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Atlas.Server");
   App     : constant Atlas.Applications.Application_Access := new Atlas.Applications.Application;

   procedure Configure (Config : in out AWS.Config.Object) is
   begin
      AWS.Config.Set.Input_Line_Size_Limit (1_000_000);
      AWS.Config.Set.Max_Connection (Config, 2);
      AWS.Config.Set.Accept_Queue_Size (Config, 100);
      AWS.Config.Set.Send_Buffer_Size (Config, 128 * 1024);
      AWS.Config.Set.Upload_Size_Limit (Config, 100_000_000);
   end Configure;

   WS        : Servlet.Server.Web.AWS_Container renames Server_Commands.WS;
   Context   : AWA.Commands.Context_Type;
   Arguments : Util.Commands.Dynamic_Argument_List;
begin
   ADO.Drivers.Initialize;

   WS.Register_Application (Atlas.Applications.CONTEXT_PATH, App.all'Access);

   if not AWS.Net.SSL.Is_Supported then
      Log.Error ("SSL is not supported by AWS.");
      Log.Error ("SSL is required for the OAuth2/OpenID connector to "
                 & "connect to OAuth2/OpenID providers.");
      Log.Error ("Please, rebuild AWS with SSL support.");
   end if;

   Log.Info ("Connect you browser to: http://localhost:8080{0}/index.html",
             Atlas.Applications.CONTEXT_PATH);
   Server_Commands.Run (Context, Arguments);

exception
   when E : others =>
      Log.Error ("Exception in server: " &
                 Ada.Exceptions.Exception_Name (E) & ": " &
                 Ada.Exceptions.Exception_Message (E));
end Atlas.Server;

Update the server to use the AWA.Commands and benefit from various commands (start, stop, setup, list)


-----------------------------------------------------------------------
--  gen-artifacts-docs -- Artifact for documentation
--  Copyright (C) 2012, 2015, 2017 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.Containers.Indefinite_Vectors;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Hash;
with Ada.Strings.Unbounded;
with Ada.Text_IO;

with Gen.Model.Packages;

--  with Asis;
--  with Asis.Text;
--  with Asis.Elements;
--  with Asis.Exceptions;
--  with Asis.Errors;
--  with Asis.Implementation;
--  with Asis.Elements;
--  with Asis.Declarations;
--  The Gen.Artifacts.Docs package is an artifact for the generation of
--  application documentation.  Its purpose is to scan the project source files
--  and extract some interesting information for a developer's guide.  The artifact
--  scans the Ada source files, the XML configuration files, the XHTML files.
--
--  The generated documentation is intended to be published on a web site.
--  The Google Wiki style is generated by default.
--
--  1/ In the first step, the project files are scanned and the useful
--     documentation is extracted.
--
--  2/ In the second step, the documentation is merged and reconciled.  Links to
--     documentation pages and references are setup and the final pages are generated.
--
--  Ada
--  ---
--  The documentation starts at the first '== TITLE ==' marker and finishes before the
--  package specification.
--
--  XHTML
--  -----
--  Same as Ada.
--
--  XML Files
--  ----------
--  The documentation is part of the XML and the documentation or description
--  tags are extracted.
package Gen.Artifacts.Docs is

   --  Tag marker (same as Java).
   TAG_CHAR     : constant Character := '@';

   --  Specific tags recognized when analyzing the documentation.
   TAG_AUTHOR   : constant String := "author";
   TAG_TITLE    : constant String := "title";
   TAG_INCLUDE  : constant String := "include";
   TAG_SEE      : constant String := "see";

   type Doc_Format is (DOC_MARKDOWN, DOC_WIKI_GOOGLE);

   --  ------------------------------
   --  Documentation artifact
   --  ------------------------------
   type Artifact is new Gen.Artifacts.Artifact with private;

   --  Prepare the model after all the configuration files have been read and before
   --  actually invoking the generation.
   overriding
   procedure Prepare (Handler : in out Artifact;
                      Model   : in out Gen.Model.Packages.Model_Definition'Class;
                      Context : in out Generator'Class);

   --  Set the output document format to generate.
   procedure Set_Format (Handler : in out Artifact;
                         Format  : in Doc_Format;
                         Footer  : in Boolean);

private

   type Line_Kind is (L_TEXT, L_LIST, L_LIST_ITEM, L_SEE, L_INCLUDE, L_START_CODE, L_END_CODE,
                      L_HEADER_1, L_HEADER_2, L_HEADER_3, L_HEADER_4);

   type Line_Type (Len : Natural) is record
      Kind    : Line_Kind := L_TEXT;
      Content : String (1 .. Len);
   end record;

   package Line_Vectors is
      new Ada.Containers.Indefinite_Vectors (Index_Type   => Positive,
                                             Element_Type => Line_Type);

   type Doc_State is (IN_PARA, IN_SEPARATOR, IN_CODE, IN_CODE_SEPARATOR, IN_LIST);

   type Document_Formatter is abstract tagged null record;
   type Document_Formatter_Access is access all Document_Formatter'Class;

   type File_Document is record
      Name         : Ada.Strings.Unbounded.Unbounded_String;
      Title        : Ada.Strings.Unbounded.Unbounded_String;
      State        : Doc_State := IN_PARA;
      Line_Number  : Natural := 0;
      Lines        : Line_Vectors.Vector;
      Was_Included : Boolean := False;
      Print_Footer : Boolean := True;
      Formatter    : Document_Formatter_Access;
   end record;

   --  Get the document name from the file document (ex: <name>.wiki or <name>.md).
   function Get_Document_Name (Formatter : in Document_Formatter;
                               Document  : in File_Document) return String is abstract;

   --  Start a new document.
   procedure Start_Document (Formatter : in out Document_Formatter;
                             Document  : in File_Document;
                             File      : in Ada.Text_IO.File_Type) is abstract;

   --  Write a line in the target document formatting the line if necessary.
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in Line_Type) is abstract;

   --  Finish the document.
   procedure Finish_Document (Formatter : in out Document_Formatter;
                              Document  : in File_Document;
                              File      : in Ada.Text_IO.File_Type;
                              Source    : in String) is abstract;

   package Doc_Maps is
     new Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                                Element_Type    => File_Document,
                                                Hash            => Ada.Strings.Hash,
                                                Equivalent_Keys => "=");

   --  Include the document extract represented by Name into the document Into.
   --  The included document is marked so that it will not be generated.
   procedure Include (Docs     : in out Doc_Maps.Map;
                      Into     : in out File_Document;
                      Name     : in String;
                      Position : in Natural);

   --  Generate the project documentation that was collected in Docs.
   --  The documentation is merged so that the @include tags are replaced by the matching
   --  document extracts.
   procedure Generate (Docs : in out Doc_Maps.Map;
                       Dir  : in String);

   --  Returns True if the line indicates a bullet or numbered list.
   function Is_List (Line : in String) return Boolean;

   --  Returns True if the line indicates a code sample.
   function Is_Code (Line : in String) return Boolean;

   --  Append a raw text line to the document.
   procedure Append_Line (Doc  : in out File_Document;
                          Line : in String);

   --  Look and analyze the tag defined on the line.
   procedure Append_Tag (Doc : in out File_Document;
                         Tag : in String);

   --  Analyse the documentation line and collect the documentation text.
   procedure Append (Doc   : in out File_Document;
                     Line  : in String);

   --  After having collected the documentation, terminate the document by making sure
   --  the opened elements are closed.
   procedure Finish (Doc : in out File_Document);

   --  Set the name associated with the document extract.
   procedure Set_Name (Doc  : in out File_Document;
                       Name : in String);

   --  Set the title associated with the document extract.
   procedure Set_Title (Doc   : in out File_Document;
                        Title : in String);

   --  Scan the files in the directory refered to by Path and collect the documentation
   --  in the Docs hashed map.
   procedure Scan_Files (Handler : in out Artifact;
                         Path    : in String;
                         Docs    : in out Doc_Maps.Map);

   --  Read the Ada specification file and collect the useful documentation.
   --  To keep the implementation simple, we don't use the ASIS packages to scan and extract
   --  the documentation.  We don't need to look at the Ada specification itself.  Instead,
   --  we assume that the Ada source follows some Ada style guidelines.
   procedure Read_Ada_File (Handler : in out Artifact;
                            File    : in String;
                            Result  : in out File_Document);

   procedure Read_Xml_File (Handler : in out Artifact;
                            File    : in String;
                            Result  : in out File_Document);

   type Artifact is new Gen.Artifacts.Artifact with record
      Xslt_Command : Ada.Strings.Unbounded.Unbounded_String;
      Format       : Doc_Format := DOC_WIKI_GOOGLE;
      Print_Footer : Boolean := True;
      Formatter    : Document_Formatter_Access;
   end record;

end Gen.Artifacts.Docs;

-----------------------------------------------------------------------
--  gen-artifacts-docs -- Artifact for documentation
--  Copyright (C) 2012, 2015, 2017 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.Containers.Indefinite_Vectors;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Hash;
with Ada.Strings.Unbounded;
with Ada.Text_IO;

with Gen.Model.Packages;
private with Util.Strings.Maps;

--  with Asis;
--  with Asis.Text;
--  with Asis.Elements;
--  with Asis.Exceptions;
--  with Asis.Errors;
--  with Asis.Implementation;
--  with Asis.Elements;
--  with Asis.Declarations;
--  The Gen.Artifacts.Docs package is an artifact for the generation of
--  application documentation.  Its purpose is to scan the project source files
--  and extract some interesting information for a developer's guide.  The artifact
--  scans the Ada source files, the XML configuration files, the XHTML files.
--
--  The generated documentation is intended to be published on a web site.
--  The Google Wiki style is generated by default.
--
--  1/ In the first step, the project files are scanned and the useful
--     documentation is extracted.
--
--  2/ In the second step, the documentation is merged and reconciled.  Links to
--     documentation pages and references are setup and the final pages are generated.
--
--  Ada
--  ---
--  The documentation starts at the first '== TITLE ==' marker and finishes before the
--  package specification.
--
--  XHTML
--  -----
--  Same as Ada.
--
--  XML Files
--  ----------
--  The documentation is part of the XML and the documentation or description
--  tags are extracted.
package Gen.Artifacts.Docs is

   --  Tag marker (same as Java).
   TAG_CHAR     : constant Character := '@';

   --  Specific tags recognized when analyzing the documentation.
   TAG_AUTHOR   : constant String := "author";
   TAG_TITLE    : constant String := "title";
   TAG_INCLUDE  : constant String := "include";
   TAG_SEE      : constant String := "see";

   type Doc_Format is (DOC_MARKDOWN, DOC_WIKI_GOOGLE);

   --  ------------------------------
   --  Documentation artifact
   --  ------------------------------
   type Artifact is new Gen.Artifacts.Artifact with private;

   --  Prepare the model after all the configuration files have been read and before
   --  actually invoking the generation.
   overriding
   procedure Prepare (Handler : in out Artifact;
                      Model   : in out Gen.Model.Packages.Model_Definition'Class;
                      Context : in out Generator'Class);

   --  Set the output document format to generate.
   procedure Set_Format (Handler : in out Artifact;
                         Format  : in Doc_Format;
                         Footer  : in Boolean);

   --  Load from the file a list of link definitions which can be injected in the generated doc.
   --  This allows to avoid polluting the Ada code with external links.
   procedure Read_Links (Handler : in out Artifact;
                         Path    : in String);

private

   type Line_Kind is (L_TEXT, L_LIST, L_LIST_ITEM, L_SEE, L_INCLUDE, L_START_CODE, L_END_CODE,
                      L_HEADER_1, L_HEADER_2, L_HEADER_3, L_HEADER_4);

   type Line_Type (Len : Natural) is record
      Kind    : Line_Kind := L_TEXT;
      Content : String (1 .. Len);
   end record;

   package Line_Vectors is
      new Ada.Containers.Indefinite_Vectors (Index_Type   => Positive,
                                             Element_Type => Line_Type);

   type Doc_State is (IN_PARA, IN_SEPARATOR, IN_CODE, IN_CODE_SEPARATOR, IN_LIST);

   type Document_Formatter is abstract tagged record
      Links : Util.Strings.Maps.Map;
   end record;
   type Document_Formatter_Access is access all Document_Formatter'Class;

   type File_Document is record
      Name         : Ada.Strings.Unbounded.Unbounded_String;
      Title        : Ada.Strings.Unbounded.Unbounded_String;
      State        : Doc_State := IN_PARA;
      Line_Number  : Natural := 0;
      Lines        : Line_Vectors.Vector;
      Was_Included : Boolean := False;
      Print_Footer : Boolean := True;
      Formatter    : Document_Formatter_Access;
   end record;

   --  Get the document name from the file document (ex: <name>.wiki or <name>.md).
   function Get_Document_Name (Formatter : in Document_Formatter;
                               Document  : in File_Document) return String is abstract;

   --  Start a new document.
   procedure Start_Document (Formatter : in out Document_Formatter;
                             Document  : in File_Document;
                             File      : in Ada.Text_IO.File_Type) is abstract;

   --  Write a line in the target document formatting the line if necessary.
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in Line_Type) is abstract;

   --  Finish the document.
   procedure Finish_Document (Formatter : in out Document_Formatter;
                              Document  : in File_Document;
                              File      : in Ada.Text_IO.File_Type;
                              Source    : in String) is abstract;

   package Doc_Maps is
     new Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                                Element_Type    => File_Document,
                                                Hash            => Ada.Strings.Hash,
                                                Equivalent_Keys => "=");

   --  Include the document extract represented by Name into the document Into.
   --  The included document is marked so that it will not be generated.
   procedure Include (Docs     : in out Doc_Maps.Map;
                      Into     : in out File_Document;
                      Name     : in String;
                      Position : in Natural);

   --  Generate the project documentation that was collected in Docs.
   --  The documentation is merged so that the @include tags are replaced by the matching
   --  document extracts.
   procedure Generate (Docs : in out Doc_Maps.Map;
                       Dir  : in String);

   --  Returns True if the line indicates a bullet or numbered list.
   function Is_List (Line : in String) return Boolean;

   --  Returns True if the line indicates a code sample.
   function Is_Code (Line : in String) return Boolean;

   --  Append a raw text line to the document.
   procedure Append_Line (Doc  : in out File_Document;
                          Line : in String);

   --  Look and analyze the tag defined on the line.
   procedure Append_Tag (Doc : in out File_Document;
                         Tag : in String);

   --  Analyse the documentation line and collect the documentation text.
   procedure Append (Doc   : in out File_Document;
                     Line  : in String);

   --  After having collected the documentation, terminate the document by making sure
   --  the opened elements are closed.
   procedure Finish (Doc : in out File_Document);

   --  Set the name associated with the document extract.
   procedure Set_Name (Doc  : in out File_Document;
                       Name : in String);

   --  Set the title associated with the document extract.
   procedure Set_Title (Doc   : in out File_Document;
                        Title : in String);

   --  Scan the files in the directory refered to by Path and collect the documentation
   --  in the Docs hashed map.
   procedure Scan_Files (Handler : in out Artifact;
                         Path    : in String;
                         Docs    : in out Doc_Maps.Map);

   --  Read the Ada specification file and collect the useful documentation.
   --  To keep the implementation simple, we don't use the ASIS packages to scan and extract
   --  the documentation.  We don't need to look at the Ada specification itself.  Instead,
   --  we assume that the Ada source follows some Ada style guidelines.
   procedure Read_Ada_File (Handler : in out Artifact;
                            File    : in String;
                            Result  : in out File_Document);

   procedure Read_Xml_File (Handler : in out Artifact;
                            File    : in String;
                            Result  : in out File_Document);

   type Artifact is new Gen.Artifacts.Artifact with record
      Xslt_Command : Ada.Strings.Unbounded.Unbounded_String;
      Format       : Doc_Format := DOC_WIKI_GOOGLE;
      Print_Footer : Boolean := True;
      Formatter    : Document_Formatter_Access;
   end record;

end Gen.Artifacts.Docs;

Declare the Read_Links procedure to read the documentation links file


--  Copyright (c) 2017 onox <denkpadje@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.Numerics.Generic_Elementary_Functions;

with Ahven; use Ahven;

with GL.Types;

with Orka.SIMD;
with Orka.Transforms.Singles.Quaternions;
with Orka.Transforms.Singles.Vectors;

package body Test_Transforms_Singles_Quaternions is

   use GL.Types;
   use Orka.SIMD;
   use Orka.Transforms.Singles.Quaternions;

   package Vectors renames Orka.Transforms.Singles.Vectors;

   use type Vector4;

   package EF is new Ada.Numerics.Generic_Elementary_Functions (Single);

   function Is_Equivalent (Expected, Result : GL.Types.Single) return Boolean is
      Epsilon : constant GL.Types.Single := 2.0 ** (1 - GL.Types.Single'Model_Mantissa);
   begin
      return Result in Expected - Epsilon .. Expected + Epsilon;
   end Is_Equivalent;

   overriding
   procedure Initialize (T : in out Test) is
   begin
      T.Set_Name ("Quaternions");

      T.Add_Test_Routine (Test_Multiplication'Access, "Test '*' operator");
      T.Add_Test_Routine (Test_Conjugate'Access, "Test Conjugate function");
      T.Add_Test_Routine (Test_Norm'Access, "Test Norm function");
      T.Add_Test_Routine (Test_Normalize'Access, "Test Normalize function");
      T.Add_Test_Routine (Test_Normalized'Access, "Test Normalized function");
      T.Add_Test_Routine (Test_Rotate_Axis_Angle'Access, "Test Rotate_Axis_Angle function");
      T.Add_Test_Routine (Test_Rotate_Vectors'Access, "Test Rotate_Vectors function");
      T.Add_Test_Routine (Test_Rotate_At_Origin'Access, "Test Rotate_At_Origin procedure");
      T.Add_Test_Routine (Test_Slerp'Access, "Test Slerp function");
   end Initialize;

   procedure Test_Multiplication is
      Half_Angle : constant GL.Types.Single := 45.0;
   begin
      declare
         Axis  : constant Vector4 := Vectors.Normalize ((1.0, 2.0, 3.0, 0.0));

         Sin_Value : constant GL.Types.Single := EF.Sin (Half_Angle, 360.0);
         Cos_Value : constant GL.Types.Single := EF.Cos (Half_Angle, 360.0);

         Result   : constant Quaternion := R (Axis, Half_Angle) * R (Axis, Half_Angle);
         Expected : constant Quaternion := (Axis (X) * Sin_Value,
                                            Axis (Y) * Sin_Value,
                                            Axis (Z) * Sin_Value,
                                            Cos_Value);
      begin
         for I in Index_Homogeneous loop
            Assert (Is_Equivalent (Expected (I), Result (I)),
              "A Unexpected Single at " & Index_Homogeneous'Image (I));
         end loop;
         Assert (Normalized (Result), "Result not normalized");
      end;

      declare
         Axis  : constant Vector4 := (1.0, 0.0, 0.0, 0.0);

         Rotation : constant Quaternion := R (Axis, 30.0) * R (Axis, 30.0) * R (Axis, 30.0);

         Expected : constant Vector4 := (0.0, 0.0, 1.0, 0.0);
         Result   : Vector4 := (0.0, 1.0, 0.0, 0.0);
      begin
         Rotate_At_Origin (Result, Rotation);

         for I in Index_Homogeneous loop
            Assert (Is_Equivalent (Expected (I), Result (I)),
              "B Unexpected Single at " & Index_Homogeneous'Image (I));
         end loop;
      end;
   end Test_Multiplication;

   procedure Test_Conjugate is
      Elements : constant Quaternion := (1.0, 2.0, 3.0, 4.0);

      Expected : constant Quaternion := (-1.0, -2.0, -3.0, 4.0);
      Result   : constant Quaternion := Conjugate (Elements);
   begin
      for I in Index_Homogeneous loop
         Assert (Is_Equivalent (Expected (I), Result (I)),
           "Unexpected Single at " & Index_Homogeneous'Image (I));
      end loop;
   end Test_Conjugate;

   procedure Test_Norm is
      Elements_1 : constant Quaternion := (1.0, 2.0, 3.0, 4.0);
      Elements_2 : constant Quaternion := (-1.0, 2.0, -3.0, 4.0);
      Elements_3 : constant Quaternion := (0.0, 0.0, 0.0, 0.0);

      Result_1   : constant GL.Types.Single := Norm (Elements_1);
      Result_2   : constant GL.Types.Single := Norm (Elements_2);
      Result_3   : constant GL.Types.Single := Norm (Elements_3);

      Expected_1 : constant GL.Types.Single := EF.Sqrt (30.0);
      Expected_2 : constant GL.Types.Single := EF.Sqrt (30.0);
      Expected_3 : constant GL.Types.Single := 0.0;
   begin
      Assert (Is_Equivalent (Expected_1, Result_1), "Unexpected Single " & GL.Types.Single'Image (Result_1));
      Assert (Is_Equivalent (Expected_2, Result_2), "Unexpected Single " & GL.Types.Single'Image (Result_2));
      Assert (Is_Equivalent (Expected_3, Result_3), "Unexpected Single " & GL.Types.Single'Image (Result_3));
   end Test_Norm;

   procedure Test_Normalize is
      Elements : constant Quaternion := (1.0, 2.0, 3.0, 4.0);
   begin
      Assert (not Normalized (Elements), "Elements is unexpectedly a unit quaternion");
      declare
         Result : constant Quaternion := Normalize (Elements);
      begin
         Assert (Normalized (Result), "Result not normalized");
      end;
   end Test_Normalize;

   procedure Test_Normalized is
      Elements_1 : constant Quaternion := (0.0, 0.0, 0.0, 1.0);
      Elements_2 : constant Quaternion := (0.5, 0.5, 0.5, -0.5);
      Elements_3 : constant Quaternion := (0.0, -1.0, 0.0, 0.0);

      Elements_4 : constant Quaternion := (1.0, 2.0, 3.0, 4.0);
   begin
      Assert (Normalized (Elements_1), "Elements_1 not normalized");
      Assert (Normalized (Elements_2), "Elements_2 not normalized");
      Assert (Normalized (Elements_3), "Elements_3 not normalized");

      Assert (not Normalized (Elements_4), "Elements_4 normalized");
   end Test_Normalized;

   procedure Test_Rotate_Axis_Angle is
      Axis  : constant Vector4 := Vectors.Normalize ((1.0, 2.0, 3.0, 0.0));
      Angle : constant GL.Types.Single := 90.0;

      Sin_Value : constant GL.Types.Single := EF.Sin (45.0, 360.0);
      Cos_Value : constant GL.Types.Single := EF.Cos (45.0, 360.0);

      Result   : constant Quaternion := R (Axis, Angle);
      Expected : constant Quaternion := (Axis (X) * Sin_Value,
                                         Axis (Y) * Sin_Value,
                                         Axis (Z) * Sin_Value,
                                         Cos_Value);
   begin
      for I in Index_Homogeneous loop
         Assert (Is_Equivalent (Expected (I), Result (I)),
           "Unexpected Single at " & Index_Homogeneous'Image (I));
      end loop;
      Assert (Normalized (Result), "Result not normalized");
   end Test_Rotate_Axis_Angle;

   procedure Test_Rotate_Vectors is
      Start_Vector : constant Vector4 := (0.0, 1.0, 0.0, 0.0);
      End_Vector   : constant Vector4 := (0.0, 0.0, 1.0, 0.0);

      Axis  : constant Vector4 := (1.0, 0.0, 0.0, 0.0);
      Angle : constant GL.Types.Single := 90.0;

      Expected : constant Quaternion := R (Axis, Angle);
      Result   : constant Quaternion := R (Start_Vector, End_Vector);
   begin
      for I in Index_Homogeneous loop
         Assert (Is_Equivalent (Expected (I), Result (I)),
           "Unexpected Single at " & Index_Homogeneous'Image (I));
      end loop;
   end Test_Rotate_Vectors;

   procedure Test_Rotate_At_Origin is
      Axis  : constant Vector4 := (1.0, 0.0, 0.0, 0.0);
      Angle : constant GL.Types.Single := 90.0;

      Rotation : constant Quaternion := R (Axis, Angle);

      Expected : constant Vector4 := (0.0, 0.0, 1.0, 0.0);
      Result   : Vector4 := (0.0, 1.0, 0.0, 0.0);
   begin
      Rotate_At_Origin (Result, Rotation);

      for I in Index_Homogeneous loop
         Assert (Is_Equivalent (Expected (I), Result (I)),
           "Unexpected Single at " & Index_Homogeneous'Image (I));
      end loop;
   end Test_Rotate_At_Origin;

   procedure Test_Slerp is
      Axis  : constant Vector4 := (1.0, 0.0, 0.0, 0.0);
      Angle : constant GL.Types.Single := 45.0;

      Start_Quaternion : constant Quaternion := R (Axis, 0.0);
      End_Quaternion   : constant Quaternion := R (Axis, 90.0);

      Expected : constant Quaternion := R (Axis, Angle);
      Result   : constant Quaternion := Slerp (Start_Quaternion, End_Quaternion, 0.5);
   begin
      for I in Index_Homogeneous loop
         Assert (Is_Equivalent (Expected (I), Result (I)),
           "Unexpected Single at " & Index_Homogeneous'Image (I));
      end loop;
   end Test_Slerp;

end Test_Transforms_Singles_Quaternions;

--  Copyright (c) 2017 onox <denkpadje@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.Numerics.Generic_Elementary_Functions;

with Ahven; use Ahven;

with GL.Types;

with Orka.SIMD;
with Orka.Transforms.Singles.Quaternions;
with Orka.Transforms.Singles.Vectors;

package body Test_Transforms_Singles_Quaternions is

   use GL.Types;
   use Orka.SIMD;
   use Orka.Transforms.Singles.Quaternions;

   package Vectors renames Orka.Transforms.Singles.Vectors;

   use type Vector4;

   package EF is new Ada.Numerics.Generic_Elementary_Functions (Single);

   function Is_Equivalent (Expected, Result : GL.Types.Single) return Boolean is
      Epsilon : constant GL.Types.Single := GL.Types.Single'Model_Epsilon;
   begin
      return Result in Expected - Epsilon .. Expected + Epsilon;
   end Is_Equivalent;

   overriding
   procedure Initialize (T : in out Test) is
   begin
      T.Set_Name ("Quaternions");

      T.Add_Test_Routine (Test_Multiplication'Access, "Test '*' operator");
      T.Add_Test_Routine (Test_Conjugate'Access, "Test Conjugate function");
      T.Add_Test_Routine (Test_Norm'Access, "Test Norm function");
      T.Add_Test_Routine (Test_Normalize'Access, "Test Normalize function");
      T.Add_Test_Routine (Test_Normalized'Access, "Test Normalized function");
      T.Add_Test_Routine (Test_Rotate_Axis_Angle'Access, "Test Rotate_Axis_Angle function");
      T.Add_Test_Routine (Test_Rotate_Vectors'Access, "Test Rotate_Vectors function");
      T.Add_Test_Routine (Test_Rotate_At_Origin'Access, "Test Rotate_At_Origin procedure");
      T.Add_Test_Routine (Test_Slerp'Access, "Test Slerp function");
   end Initialize;

   procedure Test_Multiplication is
      Half_Angle : constant GL.Types.Single := 45.0;
   begin
      declare
         Axis  : constant Vector4 := Vectors.Normalize ((1.0, 2.0, 3.0, 0.0));

         Sin_Value : constant GL.Types.Single := EF.Sin (Half_Angle, 360.0);
         Cos_Value : constant GL.Types.Single := EF.Cos (Half_Angle, 360.0);

         Result   : constant Quaternion := R (Axis, Half_Angle) * R (Axis, Half_Angle);
         Expected : constant Quaternion := (Axis (X) * Sin_Value,
                                            Axis (Y) * Sin_Value,
                                            Axis (Z) * Sin_Value,
                                            Cos_Value);
      begin
         for I in Index_Homogeneous loop
            Assert (Is_Equivalent (Expected (I), Result (I)),
              "A Unexpected Single at " & Index_Homogeneous'Image (I));
         end loop;
         Assert (Normalized (Result), "Result not normalized");
      end;

      declare
         Axis  : constant Vector4 := (1.0, 0.0, 0.0, 0.0);

         Rotation : constant Quaternion := R (Axis, 30.0) * R (Axis, 30.0) * R (Axis, 30.0);

         Expected : constant Vector4 := (0.0, 0.0, 1.0, 0.0);
         Result   : Vector4 := (0.0, 1.0, 0.0, 0.0);
      begin
         Rotate_At_Origin (Result, Rotation);

         for I in Index_Homogeneous loop
            Assert (Is_Equivalent (Expected (I), Result (I)),
              "B Unexpected Single at " & Index_Homogeneous'Image (I));
         end loop;
      end;
   end Test_Multiplication;

   procedure Test_Conjugate is
      Elements : constant Quaternion := (1.0, 2.0, 3.0, 4.0);

      Expected : constant Quaternion := (-1.0, -2.0, -3.0, 4.0);
      Result   : constant Quaternion := Conjugate (Elements);
   begin
      for I in Index_Homogeneous loop
         Assert (Is_Equivalent (Expected (I), Result (I)),
           "Unexpected Single at " & Index_Homogeneous'Image (I));
      end loop;
   end Test_Conjugate;

   procedure Test_Norm is
      Elements_1 : constant Quaternion := (1.0, 2.0, 3.0, 4.0);
      Elements_2 : constant Quaternion := (-1.0, 2.0, -3.0, 4.0);
      Elements_3 : constant Quaternion := (0.0, 0.0, 0.0, 0.0);

      Result_1   : constant GL.Types.Single := Norm (Elements_1);
      Result_2   : constant GL.Types.Single := Norm (Elements_2);
      Result_3   : constant GL.Types.Single := Norm (Elements_3);

      Expected_1 : constant GL.Types.Single := EF.Sqrt (30.0);
      Expected_2 : constant GL.Types.Single := EF.Sqrt (30.0);
      Expected_3 : constant GL.Types.Single := 0.0;
   begin
      Assert (Is_Equivalent (Expected_1, Result_1), "Unexpected Single " & GL.Types.Single'Image (Result_1));
      Assert (Is_Equivalent (Expected_2, Result_2), "Unexpected Single " & GL.Types.Single'Image (Result_2));
      Assert (Is_Equivalent (Expected_3, Result_3), "Unexpected Single " & GL.Types.Single'Image (Result_3));
   end Test_Norm;

   procedure Test_Normalize is
      Elements : constant Quaternion := (1.0, 2.0, 3.0, 4.0);
   begin
      Assert (not Normalized (Elements), "Elements is unexpectedly a unit quaternion");
      declare
         Result : constant Quaternion := Normalize (Elements);
      begin
         Assert (Normalized (Result), "Result not normalized");
      end;
   end Test_Normalize;

   procedure Test_Normalized is
      Elements_1 : constant Quaternion := (0.0, 0.0, 0.0, 1.0);
      Elements_2 : constant Quaternion := (0.5, 0.5, 0.5, -0.5);
      Elements_3 : constant Quaternion := (0.0, -1.0, 0.0, 0.0);

      Elements_4 : constant Quaternion := (1.0, 2.0, 3.0, 4.0);
   begin
      Assert (Normalized (Elements_1), "Elements_1 not normalized");
      Assert (Normalized (Elements_2), "Elements_2 not normalized");
      Assert (Normalized (Elements_3), "Elements_3 not normalized");

      Assert (not Normalized (Elements_4), "Elements_4 normalized");
   end Test_Normalized;

   procedure Test_Rotate_Axis_Angle is
      Axis  : constant Vector4 := Vectors.Normalize ((1.0, 2.0, 3.0, 0.0));
      Angle : constant GL.Types.Single := 90.0;

      Sin_Value : constant GL.Types.Single := EF.Sin (45.0, 360.0);
      Cos_Value : constant GL.Types.Single := EF.Cos (45.0, 360.0);

      Result   : constant Quaternion := R (Axis, Angle);
      Expected : constant Quaternion := (Axis (X) * Sin_Value,
                                         Axis (Y) * Sin_Value,
                                         Axis (Z) * Sin_Value,
                                         Cos_Value);
   begin
      for I in Index_Homogeneous loop
         Assert (Is_Equivalent (Expected (I), Result (I)),
           "Unexpected Single at " & Index_Homogeneous'Image (I));
      end loop;
      Assert (Normalized (Result), "Result not normalized");
   end Test_Rotate_Axis_Angle;

   procedure Test_Rotate_Vectors is
      Start_Vector : constant Vector4 := (0.0, 1.0, 0.0, 0.0);
      End_Vector   : constant Vector4 := (0.0, 0.0, 1.0, 0.0);

      Axis  : constant Vector4 := (1.0, 0.0, 0.0, 0.0);
      Angle : constant GL.Types.Single := 90.0;

      Expected_1 : constant Quaternion := R (Axis, Angle);
      Result_1   : constant Quaternion := R (Start_Vector, End_Vector);

      Expected_2 : constant Quaternion := R (Axis, -Angle);
      Result_2   : constant Quaternion := R (End_Vector, Start_Vector);
   begin
      for I in Index_Homogeneous loop
         Assert (Is_Equivalent (Expected_1 (I), Result_1 (I)),
           "Unexpected Single at " & Index_Homogeneous'Image (I));
      end loop;

      for I in Index_Homogeneous loop
         Assert (Is_Equivalent (Expected_2 (I), Result_2 (I)),
           "Unexpected Single at " & Index_Homogeneous'Image (I));
      end loop;
   end Test_Rotate_Vectors;

   procedure Test_Rotate_At_Origin is
      Axis  : constant Vector4 := (1.0, 0.0, 0.0, 0.0);
      Angle : constant GL.Types.Single := 90.0;

      Rotation : constant Quaternion := R (Axis, Angle);

      Expected : constant Vector4 := (0.0, 0.0, 1.0, 0.0);
      Result   : Vector4 := (0.0, 1.0, 0.0, 0.0);
   begin
      Rotate_At_Origin (Result, Rotation);

      for I in Index_Homogeneous loop
         Assert (Is_Equivalent (Expected (I), Result (I)),
           "Unexpected Single at " & Index_Homogeneous'Image (I));
      end loop;
   end Test_Rotate_At_Origin;

   procedure Test_Slerp is
      Axis  : constant Vector4 := (1.0, 0.0, 0.0, 0.0);
      Angle : constant GL.Types.Single := 45.0;

      Start_Quaternion : constant Quaternion := R (Axis, 0.0);
      End_Quaternion   : constant Quaternion := R (Axis, 90.0);

      Expected : constant Quaternion := R (Axis, Angle);
      Result   : constant Quaternion := Slerp (Start_Quaternion, End_Quaternion, 0.5);
   begin
      for I in Index_Homogeneous loop
         Assert (Is_Equivalent (Expected (I), Result (I)),
           "Unexpected Single at " & Index_Homogeneous'Image (I));
      end loop;
   end Test_Slerp;

end Test_Transforms_Singles_Quaternions;

test: Add extra test case to function Test_Rotate_Vectors

Signed-off-by: onox <34c1d3d2d1347bea60a26f46574de21a7a79b6d5@gmail.com>


-----------------------------------------------------------------------
--  el-contexts-tests - Tests the EL contexts
--  Copyright (C) 2011, 2012 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 Util.Test_Caller;

with Util.Properties;
with Util.Beans.Objects;

with EL.Contexts.Default;
package body EL.Utils.Tests is

   use Util.Tests;
   use Util.Beans.Objects;

   package Caller is new Util.Test_Caller (Test);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test EL.Utils.Expand",
                       Test_Expand_Properties'Access);
      Caller.Add_Test (Suite, "Test EL.Utils.Expand (recursion)",
                       Test_Expand_Recursion'Access);
      Caller.Add_Test (Suite, "Test EL.Utils.Eval",
                       Test_Eval'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test expand list of properties
   --  ------------------------------
   procedure Test_Expand_Properties (T : in out Test) is
      Context       : EL.Contexts.Default.Default_Context;
      Props         : Util.Properties.Manager;
      Result        : Util.Properties.Manager;
   begin
      Props.Set ("context", "#{homedir}/context");
      Props.Set ("homedir", "#{home}/#{user}");
      Props.Set ("unknown", "#{not_defined}");
      Props.Set ("user", "joe");
      Props.Set ("home", "/home");
      EL.Utils.Expand (Source  => Props,
                       Into    => Result,
                       Context => Context);

      Assert_Equals (T, "joe", String '(Result.Get ("user")), "Invalid expansion");
      Assert_Equals (T, "/home/joe", String '(Result.Get ("homedir")), "Invalid expansion");
      Assert_Equals (T, "/home/joe/context", String '(Result.Get ("context")),
                     "Invalid expansion");
      Assert_Equals (T, "", String '(Result.Get ("unknown")), "Invalid expansion");
   end Test_Expand_Properties;

   --  ------------------------------
   --  Test expand list of properties
   --  ------------------------------
   procedure Test_Expand_Recursion (T : in out Test) is
      Context       : EL.Contexts.Default.Default_Context;
      Props         : Util.Properties.Manager;
      Result        : Util.Properties.Manager;
   begin
      Props.Set ("context", "#{homedir}/context");
      Props.Set ("homedir", "#{home}/#{user}");
      Props.Set ("user", "joe");
      Props.Set ("home", "#{context}");
      EL.Utils.Expand (Source  => Props,
                       Into    => Result,
                       Context => Context);

      Assert_Equals (T, "joe", String '(Result.Get ("user")), "Invalid expansion");
      Assert_Equals (T, "/joe/context/joe/context/joe/context/joe",
                     String '(Result.Get ("homedir")),
                     "Invalid expansion");
   end Test_Expand_Recursion;

   --  ------------------------------
   --  Test expand list of properties
   --  ------------------------------
   procedure Test_Eval (T : in out Test) is
      Context : EL.Contexts.Default.Default_Context;
   begin
      Assert_Equals (T, "1", EL.Utils.Eval (Value   => "1",
                                           Context => Context), "Invalid eval <empty string>");
      Assert_Equals (T, "3", EL.Utils.Eval (Value   => "#{2+1}",
                                            Context => Context), "Invalid eval <valid expr>");
      declare
         Value, Result : Util.Beans.Objects.Object;

      begin
         Value := Util.Beans.Objects.To_Object (Integer '(123));
         Result := EL.Utils.Eval (Value  => Value,
                                  Context => Context);
         T.Assert (Value = Result, "Eval should return the same object");

         Value := Util.Beans.Objects.To_Object (String '("345"));
         Result := EL.Utils.Eval (Value  => Value,
                                  Context => Context);
         T.Assert (Value = Result, "Eval should return the same object");
      end;
   end Test_Eval;

end EL.Utils.Tests;

-----------------------------------------------------------------------
--  el-contexts-tests - Tests the EL contexts
--  Copyright (C) 2011, 2012 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 Util.Test_Caller;

with Util.Properties;
with Util.Beans.Objects;

with EL.Contexts.Default;
package body EL.Utils.Tests is

   use Util.Tests;
   use Util.Beans.Objects;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test EL.Utils.Expand",
                       Test_Expand_Properties'Access);
      Caller.Add_Test (Suite, "Test EL.Utils.Expand (recursion)",
                       Test_Expand_Recursion'Access);
      Caller.Add_Test (Suite, "Test EL.Utils.Eval",
                       Test_Eval'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test expand list of properties
   --  ------------------------------
   procedure Test_Expand_Properties (T : in out Test) is
      Context       : EL.Contexts.Default.Default_Context;
      Props         : Util.Properties.Manager;
      Result        : Util.Properties.Manager;
   begin
      Props.Set ("context", "#{homedir}/context");
      Props.Set ("homedir", "#{home}/#{user}");
      Props.Set ("unknown", "#{not_defined}");
      Props.Set ("user", "joe");
      Props.Set ("home", "/home");
      EL.Utils.Expand (Source  => Props,
                       Into    => Result,
                       Context => Context);

      Assert_Equals (T, "joe", String '(Result.Get ("user")), "Invalid expansion");
      Assert_Equals (T, "/home/joe", String '(Result.Get ("homedir")), "Invalid expansion");
      Assert_Equals (T, "/home/joe/context", String '(Result.Get ("context")),
                     "Invalid expansion");
      Assert_Equals (T, "", String '(Result.Get ("unknown")), "Invalid expansion");
   end Test_Expand_Properties;

   --  ------------------------------
   --  Test expand list of properties
   --  ------------------------------
   procedure Test_Expand_Recursion (T : in out Test) is
      Context       : EL.Contexts.Default.Default_Context;
      Props         : Util.Properties.Manager;
      Result        : Util.Properties.Manager;
   begin
      Props.Set ("context", "#{homedir}/context");
      Props.Set ("homedir", "#{home}/#{user}");
      Props.Set ("user", "joe");
      Props.Set ("home", "#{context}");
      EL.Utils.Expand (Source  => Props,
                       Into    => Result,
                       Context => Context);

      Assert_Equals (T, "joe", String '(Result.Get ("user")), "Invalid expansion");
      Assert_Equals (T, "/joe/context/joe/context/joe/context/joe",
                     String '(Result.Get ("homedir")),
                     "Invalid expansion");
   end Test_Expand_Recursion;

   --  ------------------------------
   --  Test expand list of properties
   --  ------------------------------
   procedure Test_Eval (T : in out Test) is
      Context : EL.Contexts.Default.Default_Context;
   begin
      Assert_Equals (T, "1", EL.Utils.Eval (Value   => "1",
                                           Context => Context), "Invalid eval <empty string>");
      Assert_Equals (T, "3", EL.Utils.Eval (Value   => "#{2+1}",
                                            Context => Context), "Invalid eval <valid expr>");
      declare
         Value, Result : Util.Beans.Objects.Object;

      begin
         Value := Util.Beans.Objects.To_Object (Integer '(123));
         Result := EL.Utils.Eval (Value  => Value,
                                  Context => Context);
         T.Assert (Value = Result, "Eval should return the same object");

         Value := Util.Beans.Objects.To_Object (String '("345"));
         Result := EL.Utils.Eval (Value  => Value,
                                  Context => Context);
         T.Assert (Value = Result, "Eval should return the same object");
      end;
   end Test_Eval;

end EL.Utils.Tests;

Use the name EL.Utils for the test

Use the name EL.Utils for the test