-----------------------------------------------------------------------
--  ado-drivers-tests -- Unit tests for database drivers
--  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 Util.Test_Caller;

with ADO.Drivers.Connections;
package body ADO.Drivers.Tests is

   use ADO.Drivers.Connections;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ADO.Drivers.Get_Config",
                       Test_Get_Config'Access);
      Caller.Add_Test (Suite, "Test ADO.Drivers.Get_Driver",
                       Test_Get_Driver'Access);
      Caller.Add_Test (Suite, "Test ADO.Drivers.Get_Driver_Index",
                       Test_Get_Driver_Index'Access);
      Caller.Add_Test (Suite, "Test ADO.Drivers.Get_Driver",
                       Test_Load_Invalid_Driver'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test the Get_Config operation.
   --  ------------------------------
   procedure Test_Get_Config (T : in out Test) is
   begin
      T.Assert (ADO.Drivers.Get_Config ("test.database")'Length > 0,
                "The Get_Config operation returned no value for the test database");
   end Test_Get_Config;

   --  ------------------------------
   --  Test the Get_Driver operation.
   --  ------------------------------
   procedure Test_Get_Driver (T : in out Test) is
      Mysql_Driver  : constant Driver_Access := ADO.Drivers.Connections.Get_Driver ("mysql");
      Sqlite_Driver : constant Driver_Access := ADO.Drivers.Connections.Get_Driver ("sqlite");
   begin
      T.Assert (Mysql_Driver /= null or Sqlite_Driver /= null,
                "No database driver was found!");
   end Test_Get_Driver;

   --  ------------------------------
   --  Test loading some invalid database driver.
   --  ------------------------------
   procedure Test_Load_Invalid_Driver (T : in out Test) is
      Invalid_Driver  : constant Driver_Access := ADO.Drivers.Connections.Get_Driver ("invalid");
   begin
      T.Assert (Invalid_Driver = null,
                "The Get_Driver operation must return null for invalid drivers");
   end Test_Load_Invalid_Driver;

   --  ------------------------------
   --  Test the Get_Driver_Index operation.
   --  ------------------------------
   procedure Test_Get_Driver_Index (T : in out Test) is
      Mysql_Driver  : constant Driver_Access := ADO.Drivers.Connections.Get_Driver ("mysql");
      Sqlite_Driver : constant Driver_Access := ADO.Drivers.Connections.Get_Driver ("sqlite");
   begin
      if Mysql_Driver /= null then
         T.Assert (Mysql_Driver.Get_Driver_Index > 0, "The driver index must be positive");
      end if;
      if Sqlite_Driver /= null then
         T.Assert (Sqlite_Driver.Get_Driver_Index > 0, "The driver index must be positive");
      end if;
      if Mysql_Driver /= null and Sqlite_Driver /= null then
         T.Assert (Mysql_Driver.Get_Driver_Index /= Sqlite_Driver.Get_Driver_Index,
                   "Two drivers must have different driver indexes");
      end if;
   end Test_Get_Driver_Index;

end ADO.Drivers.Tests;

-----------------------------------------------------------------------
--  ado-drivers-tests -- Unit tests for database drivers
--  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 Util.Test_Caller;

with ADO.Drivers.Connections;
package body ADO.Drivers.Tests is

   use ADO.Drivers.Connections;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ADO.Drivers.Get_Config",
                       Test_Get_Config'Access);
      Caller.Add_Test (Suite, "Test ADO.Drivers.Get_Driver",
                       Test_Get_Driver'Access);
      Caller.Add_Test (Suite, "Test ADO.Drivers.Get_Driver_Index",
                       Test_Get_Driver_Index'Access);
      Caller.Add_Test (Suite, "Test ADO.Drivers.Get_Driver",
                       Test_Load_Invalid_Driver'Access);
      Caller.Add_Test (Suite, "Test ADO.Drivers.Connections.Set_Connection (Errors)",
                       Test_Set_Connection_Error'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test the Get_Config operation.
   --  ------------------------------
   procedure Test_Get_Config (T : in out Test) is
   begin
      T.Assert (ADO.Drivers.Get_Config ("test.database")'Length > 0,
                "The Get_Config operation returned no value for the test database");
   end Test_Get_Config;

   --  ------------------------------
   --  Test the Get_Driver operation.
   --  ------------------------------
   procedure Test_Get_Driver (T : in out Test) is
      Mysql_Driver  : constant Driver_Access := ADO.Drivers.Connections.Get_Driver ("mysql");
      Sqlite_Driver : constant Driver_Access := ADO.Drivers.Connections.Get_Driver ("sqlite");
   begin
      T.Assert (Mysql_Driver /= null or Sqlite_Driver /= null,
                "No database driver was found!");
   end Test_Get_Driver;

   --  ------------------------------
   --  Test loading some invalid database driver.
   --  ------------------------------
   procedure Test_Load_Invalid_Driver (T : in out Test) is
      Invalid_Driver  : constant Driver_Access := ADO.Drivers.Connections.Get_Driver ("invalid");
   begin
      T.Assert (Invalid_Driver = null,
                "The Get_Driver operation must return null for invalid drivers");
   end Test_Load_Invalid_Driver;

   --  ------------------------------
   --  Test the Get_Driver_Index operation.
   --  ------------------------------
   procedure Test_Get_Driver_Index (T : in out Test) is
      Mysql_Driver  : constant Driver_Access := ADO.Drivers.Connections.Get_Driver ("mysql");
      Sqlite_Driver : constant Driver_Access := ADO.Drivers.Connections.Get_Driver ("sqlite");
   begin
      if Mysql_Driver /= null then
         T.Assert (Mysql_Driver.Get_Driver_Index > 0, "The driver index must be positive");
      end if;
      if Sqlite_Driver /= null then
         T.Assert (Sqlite_Driver.Get_Driver_Index > 0, "The driver index must be positive");
      end if;
      if Mysql_Driver /= null and Sqlite_Driver /= null then
         T.Assert (Mysql_Driver.Get_Driver_Index /= Sqlite_Driver.Get_Driver_Index,
                   "Two drivers must have different driver indexes");
      end if;
   end Test_Get_Driver_Index;

   --  ------------------------------
   --  Test the Set_Connection procedure with several error cases.
   --  ------------------------------
   procedure Test_Set_Connection_Error (T : in out Test) is

      procedure Check_Invalid_Connection (URI : in String);

      Controller : ADO.Drivers.Connections.Configuration;

      procedure Check_Invalid_Connection (URI : in String) is
      begin
         Controller.Set_Connection (URI);
         T.Fail ("No Connection_Error exception raised for " & URI);

      exception
         when Connection_Error =>
            null;

      end Check_Invalid_Connection;

   begin
      Check_Invalid_Connection ("");
      Check_Invalid_Connection ("http://");
      Check_Invalid_Connection ("mysql://");
      Check_Invalid_Connection ("sqlite://");
      Check_Invalid_Connection ("mysql://:toto/");
      Check_Invalid_Connection ("sqlite://:toto/");
   end Test_Set_Connection_Error;

end ADO.Drivers.Tests;

Implement Test_Set_Connection_Error to check various invalid URI and check that an exception is raised


-----------------------------------------------------------------------
--  mat-formats - Format various types for the console or GUI interface
--  Copyright (C) 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.
-----------------------------------------------------------------------

package body MAT.Formats is

   Hex_Prefix : Boolean := True;

   --  ------------------------------
   --  Format the address into a string.
   --  ------------------------------
   function Addr (Value : in MAT.Types.Target_Addr) return String is
      Hex : constant String := MAT.Types.Hex_Image (Value);
   begin
      if Hex_Prefix then
         return "0x" & Hex;
      else
         return Hex;
      end if;
   end Addr;

   --  ------------------------------
   --  Format the size into a string.
   --  ------------------------------
   function Size (Value : in MAT.Types.Target_Size) return String is
      Result : constant String := MAT.Types.Target_Size'Image (Value);
   begin
      if Result (Result'First) = ' ' then
         return Result (Result'First + 1 .. Result'Last);
      else
         return Result;
      end if;
   end Size;

   function Location (File : in Ada.Strings.Unbounded.Unbounded_String) return String is
      Pos : constant Natural := Ada.Strings.Unbounded.Index (File, "/", Ada.Strings.Backward);
      Len : constant Natural := Ada.Strings.Unbounded.Length (File);
   begin
      if Pos /= 0 then
         return Ada.Strings.Unbounded.Slice (File, Pos + 1, Len);
      else
         return Ada.Strings.Unbounded.To_String (File);
      end if;
   end Location;

   --  ------------------------------
   --  Format a file, line, function information into a string.
   --  ------------------------------
   function Location (File : in Ada.Strings.Unbounded.Unbounded_String;
                      Line : in Natural;
                      Func : in Ada.Strings.Unbounded.Unbounded_String) return String is
   begin
      if Ada.Strings.Unbounded.Length (File) = 0 then
         return Ada.Strings.Unbounded.To_String (Func);
      elsif Line > 0 then
         declare
            Num : constant String := Natural'Image (Line);
         begin
            return Ada.Strings.Unbounded.To_String (Func) & " ("
              & Location (File) & ":" & Num (Num'First + 1 .. Num'Last) & ")";
         end;
      else
         return Ada.Strings.Unbounded.To_String (Func) & " (" & Location (File) & ")";
      end if;
   end Location;

   function Event (Item : in MAT.Events.Targets.Probe_Event_Type) return String is
   begin
      case Item.Index is
         when MAT.Events.Targets.MSG_MALLOC =>
            return Size (Item.Size) & " bytes allocated";

         when MAT.Events.Targets.MSG_REALLOC =>
            return Size (Item.Size) & " bytes reallocated";

         when MAT.Events.Targets.MSG_FREE =>
            return Size (Item.Size) & " bytes freed";

         when others =>
            return "unknown";

      end case;
   end Event;

   function Event_Malloc (Item    : in MAT.Events.Targets.Probe_Event_Type;
                          Related : in MAT.Events.Targets.Target_Event_Vector) return String is
      Iter : MAT.Events.Targets.Target_Event_Cursor := Related.First;
      Free_Event : MAT.Events.Targets.Probe_Event_Type;
   begin
      Free_Event := MAT.Events.Targets.Find (Related, MAT.Events.Targets.MSG_FREE);

      return Size (Item.Size) & " bytes allocated, ";

   exception
      when MAT.Events.Targets.Not_Found =>
         return Size (Item.Size) & " bytes allocated";

   end Event_Malloc;

   --  Format a short description of the event.
   function Event (Item    : in MAT.Events.Targets.Probe_Event_Type;
                   Related : in MAT.Events.Targets.Target_Event_Vector) return String is
   begin
      case Item.Index is
         when MAT.Events.Targets.MSG_MALLOC =>
            return Event_Malloc (Item, Related);

         when MAT.Events.Targets.MSG_REALLOC =>
            return Size (Item.Size) & " bytes reallocated";

         when MAT.Events.Targets.MSG_FREE =>
            return Size (Item.Size) & " bytes freed";

         when MAT.Events.Targets.MSG_BEGIN =>
            return "Begin event";

         when MAT.Events.Targets.MSG_END =>
            return "End event";

         when MAT.Events.Targets.MSG_LIBRARY =>
            return "Library information event";

         when others =>
            return "unknown";

      end case;
   end Event;

end MAT.Formats;

-----------------------------------------------------------------------
--  mat-formats - Format various types for the console or GUI interface
--  Copyright (C) 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.
-----------------------------------------------------------------------

package body MAT.Formats is

   Hex_Prefix : Boolean := True;

   Conversion : constant String (1 .. 10) := "0123456789";

   --  ------------------------------
   --  Format the address into a string.
   --  ------------------------------
   function Addr (Value : in MAT.Types.Target_Addr) return String is
      Hex : constant String := MAT.Types.Hex_Image (Value);
   begin
      if Hex_Prefix then
         return "0x" & Hex;
      else
         return Hex;
      end if;
   end Addr;

   --  ------------------------------
   --  Format the size into a string.
   --  ------------------------------
   function Size (Value : in MAT.Types.Target_Size) return String is
      Result : constant String := MAT.Types.Target_Size'Image (Value);
   begin
      if Result (Result'First) = ' ' then
         return Result (Result'First + 1 .. Result'Last);
      else
         return Result;
      end if;
   end Size;

   --  ------------------------------
   --  Format the time relative to the start time.
   --  ------------------------------
   function Time (Value : in MAT.Types.Target_Tick_Ref;
                  Start : in MAT.Types.Target_Tick_Ref) return String is
      use type MAT.Types.Target_Tick_Ref;

      T    : constant MAT.Types.Target_Tick_Ref := Value - Start;
      Sec  : constant MAT.Types.Target_Tick_Ref := T / 1_000_000;
      Usec : constant MAT.Types.Target_Tick_Ref := T mod 1_000_000;
      Msec : Natural := Natural (Usec / 1_000);
      Frac : String (1 .. 5);
   begin
      Frac (5) := 's';
      Frac (4) := Conversion (Msec mod 10 + 1);
      Msec := Msec / 10;
      Frac (3) := Conversion (Msec mod 10 + 1);
      Msec := Msec / 10;
      Frac (2) := Conversion (Msec mod 10 + 1);
      Frac (1) := '.';
      return MAT.Types.Target_Tick_Ref'Image (Sec) & Frac;
   end Time;

   function Location (File : in Ada.Strings.Unbounded.Unbounded_String) return String is
      Pos : constant Natural := Ada.Strings.Unbounded.Index (File, "/", Ada.Strings.Backward);
      Len : constant Natural := Ada.Strings.Unbounded.Length (File);
   begin
      if Pos /= 0 then
         return Ada.Strings.Unbounded.Slice (File, Pos + 1, Len);
      else
         return Ada.Strings.Unbounded.To_String (File);
      end if;
   end Location;

   --  ------------------------------
   --  Format a file, line, function information into a string.
   --  ------------------------------
   function Location (File : in Ada.Strings.Unbounded.Unbounded_String;
                      Line : in Natural;
                      Func : in Ada.Strings.Unbounded.Unbounded_String) return String is
   begin
      if Ada.Strings.Unbounded.Length (File) = 0 then
         return Ada.Strings.Unbounded.To_String (Func);
      elsif Line > 0 then
         declare
            Num : constant String := Natural'Image (Line);
         begin
            return Ada.Strings.Unbounded.To_String (Func) & " ("
              & Location (File) & ":" & Num (Num'First + 1 .. Num'Last) & ")";
         end;
      else
         return Ada.Strings.Unbounded.To_String (Func) & " (" & Location (File) & ")";
      end if;
   end Location;

   function Event (Item : in MAT.Events.Targets.Probe_Event_Type) return String is
   begin
      case Item.Index is
         when MAT.Events.Targets.MSG_MALLOC =>
            return Size (Item.Size) & " bytes allocated";

         when MAT.Events.Targets.MSG_REALLOC =>
            return Size (Item.Size) & " bytes reallocated";

         when MAT.Events.Targets.MSG_FREE =>
            return Size (Item.Size) & " bytes freed";

         when others =>
            return "unknown";

      end case;
   end Event;

   function Event_Malloc (Item    : in MAT.Events.Targets.Probe_Event_Type;
                          Related : in MAT.Events.Targets.Target_Event_Vector) return String is
      Iter : MAT.Events.Targets.Target_Event_Cursor := Related.First;
      Free_Event : MAT.Events.Targets.Probe_Event_Type;
   begin
      Free_Event := MAT.Events.Targets.Find (Related, MAT.Events.Targets.MSG_FREE);

      return Size (Item.Size) & " bytes allocated, " & Time (Free_Event.Time, Item.Time);

   exception
      when MAT.Events.Targets.Not_Found =>
         return Size (Item.Size) & " bytes allocated";

   end Event_Malloc;

   --  Format a short description of the event.
   function Event (Item    : in MAT.Events.Targets.Probe_Event_Type;
                   Related : in MAT.Events.Targets.Target_Event_Vector) return String is
   begin
      case Item.Index is
         when MAT.Events.Targets.MSG_MALLOC =>
            return Event_Malloc (Item, Related);

         when MAT.Events.Targets.MSG_REALLOC =>
            return Size (Item.Size) & " bytes reallocated";

         when MAT.Events.Targets.MSG_FREE =>
            return Size (Item.Size) & " bytes freed";

         when MAT.Events.Targets.MSG_BEGIN =>
            return "Begin event";

         when MAT.Events.Targets.MSG_END =>
            return "End event";

         when MAT.Events.Targets.MSG_LIBRARY =>
            return "Library information event";

         when others =>
            return "unknown";

      end case;
   end Event;

end MAT.Formats;

Implement the Time operation to format a relative time


-----------------------------------------------------------------------
--  mat-formats - Format various types for the console or GUI interface
--  Copyright (C) 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 Util.Strings;
package body MAT.Formats is

   use type MAT.Types.Target_Tick_Ref;

   Hex_Prefix : Boolean := True;

   Conversion : constant String (1 .. 10) := "0123456789";

   --  ------------------------------
   --  Format the address into a string.
   --  ------------------------------
   function Addr (Value : in MAT.Types.Target_Addr) return String is
      Hex : constant String := MAT.Types.Hex_Image (Value);
   begin
      if Hex_Prefix then
         return "0x" & Hex;
      else
         return Hex;
      end if;
   end Addr;

   --  ------------------------------
   --  Format the size into a string.
   --  ------------------------------
   function Size (Value : in MAT.Types.Target_Size) return String is
      Result : constant String := MAT.Types.Target_Size'Image (Value);
   begin
      if Result (Result'First) = ' ' then
         return Result (Result'First + 1 .. Result'Last);
      else
         return Result;
      end if;
   end Size;

   --  ------------------------------
   --  Format the time relative to the start time.
   --  ------------------------------
   function Time (Value : in MAT.Types.Target_Tick_Ref;
                  Start : in MAT.Types.Target_Tick_Ref) return String is
      T    : constant MAT.Types.Target_Tick_Ref := Value - Start;
      Sec  : constant MAT.Types.Target_Tick_Ref := T / 1_000_000;
      Usec : constant MAT.Types.Target_Tick_Ref := T mod 1_000_000;
      Msec : Natural := Natural (Usec / 1_000);
      Frac : String (1 .. 5);
   begin
      Frac (5) := 's';
      Frac (4) := Conversion (Msec mod 10 + 1);
      Msec := Msec / 10;
      Frac (3) := Conversion (Msec mod 10 + 1);
      Msec := Msec / 10;
      Frac (2) := Conversion (Msec mod 10 + 1);
      Frac (1) := '.';
      return MAT.Types.Target_Tick_Ref'Image (Sec) & Frac;
   end Time;

   --  ------------------------------
   --  Format the duration in seconds, milliseconds or microseconds.
   --  ------------------------------
   function Duration (Value : in MAT.Types.Target_Tick_Ref) return String is

      Sec  : constant MAT.Types.Target_Tick_Ref := Value / 1_000_000;
      Usec : constant MAT.Types.Target_Tick_Ref := Value mod 1_000_000;
      Msec : Natural := Natural (Usec / 1_000);
      Val  : Natural;
      Frac : String (1 .. 5);
   begin
      if Sec = 0 and Msec = 0 then
         return Util.Strings.Image (Integer (Usec)) & "us";
      elsif Sec = 0 then
         Val := Natural (Usec mod 1_000);
         Frac (5) := 's';
         Frac (4) := 'm';
         Frac (3) := Conversion (Val mod 10 + 1);
         Val := Val / 10;
         Frac (3) := Conversion (Val mod 10 + 1);
         Val := Val / 10;
         Frac (2) := Conversion (Val mod 10 + 1);
         Frac (1) := '.';
         return Util.Strings.Image (Integer (Msec)) & Frac;
      else
         Val := Msec;
         Frac (4) := 's';
         Frac (3) := Conversion (Val mod 10 + 1);
         Val := Val / 10;
         Frac (3) := Conversion (Val mod 10 + 1);
         Val := Val / 10;
         Frac (2) := Conversion (Val mod 10 + 1);
         Frac (1) := '.';
         return Util.Strings.Image (Integer (Msec)) & Frac (1 .. 4);
      end if;
   end Duration;

   function Location (File : in Ada.Strings.Unbounded.Unbounded_String) return String is
      Pos : constant Natural := Ada.Strings.Unbounded.Index (File, "/", Ada.Strings.Backward);
      Len : constant Natural := Ada.Strings.Unbounded.Length (File);
   begin
      if Pos /= 0 then
         return Ada.Strings.Unbounded.Slice (File, Pos + 1, Len);
      else
         return Ada.Strings.Unbounded.To_String (File);
      end if;
   end Location;

   --  ------------------------------
   --  Format a file, line, function information into a string.
   --  ------------------------------
   function Location (File : in Ada.Strings.Unbounded.Unbounded_String;
                      Line : in Natural;
                      Func : in Ada.Strings.Unbounded.Unbounded_String) return String is
   begin
      if Ada.Strings.Unbounded.Length (File) = 0 then
         return Ada.Strings.Unbounded.To_String (Func);
      elsif Line > 0 then
         declare
            Num : constant String := Natural'Image (Line);
         begin
            return Ada.Strings.Unbounded.To_String (Func) & " ("
              & Location (File) & ":" & Num (Num'First + 1 .. Num'Last) & ")";
         end;
      else
         return Ada.Strings.Unbounded.To_String (Func) & " (" & Location (File) & ")";
      end if;
   end Location;

   function Event (Item : in MAT.Events.Targets.Probe_Event_Type) return String is
   begin
      case Item.Index is
         when MAT.Events.Targets.MSG_MALLOC =>
            return Size (Item.Size) & " bytes allocated";

         when MAT.Events.Targets.MSG_REALLOC =>
            return Size (Item.Size) & " bytes reallocated";

         when MAT.Events.Targets.MSG_FREE =>
            return Size (Item.Size) & " bytes freed";

         when others =>
            return "unknown";

      end case;
   end Event;

   function Event_Malloc (Item       : in MAT.Events.Targets.Probe_Event_Type;
                          Related    : in MAT.Events.Targets.Target_Event_Vector;
                          Start_Time : in MAT.Types.Target_Tick_Ref) return String is
      Iter : MAT.Events.Targets.Target_Event_Cursor := Related.First;
      Free_Event : MAT.Events.Targets.Probe_Event_Type;
   begin
      Free_Event := MAT.Events.Targets.Find (Related, MAT.Events.Targets.MSG_FREE);

      return Size (Item.Size) & " bytes allocated after " & Duration (Item.Time - Start_Time)
        & ", freed by event" & MAT.Events.Targets.Event_Id_Type'Image (Free_Event.Id)
        & " after " & Duration (Free_Event.Time - Item.Time)
      ;

   exception
      when MAT.Events.Targets.Not_Found =>
         return Size (Item.Size) & " bytes allocated";

   end Event_Malloc;

   function Event_Free (Item       : in MAT.Events.Targets.Probe_Event_Type;
                          Related    : in MAT.Events.Targets.Target_Event_Vector;
                          Start_Time : in MAT.Types.Target_Tick_Ref) return String is
      Iter : MAT.Events.Targets.Target_Event_Cursor := Related.First;
      Alloc_Event : MAT.Events.Targets.Probe_Event_Type;
   begin
      Alloc_Event := MAT.Events.Targets.Find (Related, MAT.Events.Targets.MSG_MALLOC);

      return Size (Alloc_Event.Size) & " bytes freed after " & Duration (Item.Time - Start_Time)
        & ", alloc'ed for " & Duration (Item.Time - Alloc_Event.Time)
        & " by event" & MAT.Events.Targets.Event_Id_Type'Image (Alloc_Event.Id)
      ;

   exception
      when MAT.Events.Targets.Not_Found =>
         return Size (Item.Size) & " bytes freed";

   end Event_Free;

   --  Format a short description of the event.
   function Event (Item       : in MAT.Events.Targets.Probe_Event_Type;
                   Related    : in MAT.Events.Targets.Target_Event_Vector;
                   Start_Time : in MAT.Types.Target_Tick_Ref) return String is
   begin
      case Item.Index is
         when MAT.Events.Targets.MSG_MALLOC =>
            return Event_Malloc (Item, Related, Start_Time);

         when MAT.Events.Targets.MSG_REALLOC =>
            return Size (Item.Size) & " bytes reallocated";

         when MAT.Events.Targets.MSG_FREE =>
            return Event_Free (Item, Related, Start_Time);

         when MAT.Events.Targets.MSG_BEGIN =>
            return "Begin event";

         when MAT.Events.Targets.MSG_END =>
            return "End event";

         when MAT.Events.Targets.MSG_LIBRARY =>
            return "Library information event";

         when others =>
            return "unknown";

      end case;
   end Event;

end MAT.Formats;

-----------------------------------------------------------------------
--  mat-formats - Format various types for the console or GUI interface
--  Copyright (C) 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 Util.Strings;
package body MAT.Formats is

   use type MAT.Types.Target_Tick_Ref;

   Hex_Prefix : Boolean := True;

   Conversion : constant String (1 .. 10) := "0123456789";

   --  ------------------------------
   --  Format the address into a string.
   --  ------------------------------
   function Addr (Value : in MAT.Types.Target_Addr) return String is
      Hex : constant String := MAT.Types.Hex_Image (Value);
   begin
      if Hex_Prefix then
         return "0x" & Hex;
      else
         return Hex;
      end if;
   end Addr;

   --  ------------------------------
   --  Format the size into a string.
   --  ------------------------------
   function Size (Value : in MAT.Types.Target_Size) return String is
      Result : constant String := MAT.Types.Target_Size'Image (Value);
   begin
      if Result (Result'First) = ' ' then
         return Result (Result'First + 1 .. Result'Last);
      else
         return Result;
      end if;
   end Size;

   --  ------------------------------
   --  Format the time relative to the start time.
   --  ------------------------------
   function Time (Value : in MAT.Types.Target_Tick_Ref;
                  Start : in MAT.Types.Target_Tick_Ref) return String is
      T    : constant MAT.Types.Target_Tick_Ref := Value - Start;
      Sec  : constant MAT.Types.Target_Tick_Ref := T / 1_000_000;
      Usec : constant MAT.Types.Target_Tick_Ref := T mod 1_000_000;
      Msec : Natural := Natural (Usec / 1_000);
      Frac : String (1 .. 5);
   begin
      Frac (5) := 's';
      Frac (4) := Conversion (Msec mod 10 + 1);
      Msec := Msec / 10;
      Frac (3) := Conversion (Msec mod 10 + 1);
      Msec := Msec / 10;
      Frac (2) := Conversion (Msec mod 10 + 1);
      Frac (1) := '.';
      return MAT.Types.Target_Tick_Ref'Image (Sec) & Frac;
   end Time;

   --  ------------------------------
   --  Format the duration in seconds, milliseconds or microseconds.
   --  ------------------------------
   function Duration (Value : in MAT.Types.Target_Tick_Ref) return String is

      Sec  : constant MAT.Types.Target_Tick_Ref := Value / 1_000_000;
      Usec : constant MAT.Types.Target_Tick_Ref := Value mod 1_000_000;
      Msec : Natural := Natural (Usec / 1_000);
      Val  : Natural;
      Frac : String (1 .. 5);
   begin
      if Sec = 0 and Msec = 0 then
         return Util.Strings.Image (Integer (Usec)) & "us";
      elsif Sec = 0 then
         Val := Natural (Usec mod 1_000);
         Frac (5) := 's';
         Frac (4) := 'm';
         Frac (3) := Conversion (Val mod 10 + 1);
         Val := Val / 10;
         Frac (3) := Conversion (Val mod 10 + 1);
         Val := Val / 10;
         Frac (2) := Conversion (Val mod 10 + 1);
         Frac (1) := '.';
         return Util.Strings.Image (Integer (Msec)) & Frac;
      else
         Val := Msec;
         Frac (4) := 's';
         Frac (3) := Conversion (Val mod 10 + 1);
         Val := Val / 10;
         Frac (3) := Conversion (Val mod 10 + 1);
         Val := Val / 10;
         Frac (2) := Conversion (Val mod 10 + 1);
         Frac (1) := '.';
         return Util.Strings.Image (Integer (Msec)) & Frac (1 .. 4);
      end if;
   end Duration;

   function Location (File : in Ada.Strings.Unbounded.Unbounded_String) return String is
      Pos : constant Natural := Ada.Strings.Unbounded.Index (File, "/", Ada.Strings.Backward);
      Len : constant Natural := Ada.Strings.Unbounded.Length (File);
   begin
      if Pos /= 0 then
         return Ada.Strings.Unbounded.Slice (File, Pos + 1, Len);
      else
         return Ada.Strings.Unbounded.To_String (File);
      end if;
   end Location;

   --  ------------------------------
   --  Format a file, line, function information into a string.
   --  ------------------------------
   function Location (File : in Ada.Strings.Unbounded.Unbounded_String;
                      Line : in Natural;
                      Func : in Ada.Strings.Unbounded.Unbounded_String) return String is
   begin
      if Ada.Strings.Unbounded.Length (File) = 0 then
         return Ada.Strings.Unbounded.To_String (Func);
      elsif Line > 0 then
         declare
            Num : constant String := Natural'Image (Line);
         begin
            return Ada.Strings.Unbounded.To_String (Func) & " ("
              & Location (File) & ":" & Num (Num'First + 1 .. Num'Last) & ")";
         end;
      else
         return Ada.Strings.Unbounded.To_String (Func) & " (" & Location (File) & ")";
      end if;
   end Location;

   --  ------------------------------
   --  Format a short description of the event.
   --  ------------------------------
   function Event (Item : in MAT.Events.Targets.Probe_Event_Type) return String is
   begin
      case Item.Index is
         when MAT.Events.Targets.MSG_MALLOC =>
            return "malloc(" & Size (Item.Size) & ") = " & Addr (Item.Addr);

         when MAT.Events.Targets.MSG_REALLOC =>
            return "realloc(" & Addr (Item.Old_Addr) & "," & Size (Item.Size) & ") = "
              & Addr (Item.Addr);

         when MAT.Events.Targets.MSG_FREE =>
            return "free(" & Addr (Item.Addr) & ")";

         when MAT.Events.Targets.MSG_BEGIN =>
            return "begin";

         when MAT.Events.Targets.MSG_END =>
            return "end";

         when MAT.Events.Targets.MSG_LIBRARY =>
            return "library";

         when others =>
            return "unknown";

      end case;
   end Event;

   function Event_Malloc (Item       : in MAT.Events.Targets.Probe_Event_Type;
                          Related    : in MAT.Events.Targets.Target_Event_Vector;
                          Start_Time : in MAT.Types.Target_Tick_Ref) return String is
      Iter : MAT.Events.Targets.Target_Event_Cursor := Related.First;
      Free_Event : MAT.Events.Targets.Probe_Event_Type;
   begin
      Free_Event := MAT.Events.Targets.Find (Related, MAT.Events.Targets.MSG_FREE);

      return Size (Item.Size) & " bytes allocated after " & Duration (Item.Time - Start_Time)
        & ", freed " & Duration (Free_Event.Time - Item.Time)
        & " after by event" & MAT.Events.Targets.Event_Id_Type'Image (Free_Event.Id)
      ;

   exception
      when MAT.Events.Targets.Not_Found =>
         return Size (Item.Size) & " bytes allocated (never freed)";

   end Event_Malloc;

   function Event_Free (Item       : in MAT.Events.Targets.Probe_Event_Type;
                          Related    : in MAT.Events.Targets.Target_Event_Vector;
                          Start_Time : in MAT.Types.Target_Tick_Ref) return String is
      Iter : MAT.Events.Targets.Target_Event_Cursor := Related.First;
      Alloc_Event : MAT.Events.Targets.Probe_Event_Type;
   begin
      Alloc_Event := MAT.Events.Targets.Find (Related, MAT.Events.Targets.MSG_MALLOC);

      return Size (Alloc_Event.Size) & " bytes freed after " & Duration (Item.Time - Start_Time)
        & ", alloc'ed for " & Duration (Item.Time - Alloc_Event.Time)
        & " by event" & MAT.Events.Targets.Event_Id_Type'Image (Alloc_Event.Id)
      ;

   exception
      when MAT.Events.Targets.Not_Found =>
         return Size (Item.Size) & " bytes freed";

   end Event_Free;

   --  Format a short description of the event.
   function Event (Item       : in MAT.Events.Targets.Probe_Event_Type;
                   Related    : in MAT.Events.Targets.Target_Event_Vector;
                   Start_Time : in MAT.Types.Target_Tick_Ref) return String is
   begin
      case Item.Index is
         when MAT.Events.Targets.MSG_MALLOC =>
            return Event_Malloc (Item, Related, Start_Time);

         when MAT.Events.Targets.MSG_REALLOC =>
            return Size (Item.Size) & " bytes reallocated";

         when MAT.Events.Targets.MSG_FREE =>
            return Event_Free (Item, Related, Start_Time);

         when MAT.Events.Targets.MSG_BEGIN =>
            return "Begin event";

         when MAT.Events.Targets.MSG_END =>
            return "End event";

         when MAT.Events.Targets.MSG_LIBRARY =>
            return "Library information event";

         when others =>
            return "unknown";

      end case;
   end Event;

end MAT.Formats;

Implement the new Event function to print a short description of an event


-----------------------------------------------------------------------
--  Render Tests - Unit tests for AWA Wiki rendering
--  Copyright (C) 2013, 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 Ada.Text_IO;
with Ada.Directories;
with Ada.Characters.Conversions;

with Util.Files;
with Util.Measures;

with Wiki.Render.Wiki;
with Wiki.Filters.Html;
with Wiki.Streams.Html.Builders;
with Wiki.Utils;
package body Wiki.Tests is

   use Ada.Strings.Unbounded;
   use type Wiki.Parsers.Wiki_Syntax_Type;

   --  ------------------------------
   --  Test rendering a wiki text in HTML or text.
   --  ------------------------------
   procedure Test_Render (T : in out Test) is
      function To_Wide (Item : in String) return Wide_Wide_String
        renames Ada.Characters.Conversions.To_Wide_Wide_String;

      Result_File : constant String := To_String (T.Result);
      Content     : Unbounded_String;
   begin
      Util.Files.Read_File (Path     => To_String (T.File),
                            Into     => Content,
                            Max_Size => 10000);
      declare
         Time : Util.Measures.Stamp;
      begin
         if T.Source = Wiki.Parsers.SYNTAX_HTML then
            declare
               Html_Filter : aliased Wiki.Filters.Html.Html_Filter_Type;
               Writer      : aliased Wiki.Writers.Builders.Writer_Builder_Type;
               Renderer    : aliased Wiki.Render.Wiki.Wiki_Renderer;
            begin
               Renderer.Set_Writer (Writer'Unchecked_Access, T.Format);
               Html_Filter.Set_Document (Renderer'Unchecked_Access);
               Wiki.Parsers.Parse (Html_Filter'Unchecked_Access, To_Wide (To_String (Content)),
                                   Wiki.Parsers.SYNTAX_HTML);
               Content := To_Unbounded_String (Writer.To_String);
            end;
         elsif T.Is_Html then
            Content := To_Unbounded_String
              (Utils.To_Html (To_Wide (To_String (Content)), T.Format));
         else
            Content := To_Unbounded_String
              (Utils.To_Text (To_Wide (To_String (Content)), T.Format));
         end if;

         Util.Measures.Report (Time, "Render " & To_String (T.Name));
      end;

      Util.Files.Write_File (Result_File, Content);
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => To_String (T.Expect),
                                     Test    => Result_File,
                                     Message => "Render");
   end Test_Render;

   --  ------------------------------
   --  Test case name
   --  ------------------------------
   overriding
   function Name (T : in Test) return Util.Tests.Message_String is
   begin
      if T.Source = Wiki.Parsers.SYNTAX_HTML then
         return Util.Tests.Format ("Test IMPORT " & To_String (T.Name));
      elsif T.Is_Html then
         return Util.Tests.Format ("Test HTML " & To_String (T.Name));
      else
         return Util.Tests.Format ("Test TEXT " & To_String (T.Name));
      end if;
   end Name;

   --  ------------------------------
   --  Perform the test.
   --  ------------------------------
   overriding
   procedure Run_Test (T : in out Test) is
   begin
      T.Test_Render;
   end Run_Test;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
      use Ada.Directories;

      procedure Add_Import_Tests;
      procedure Add_Wiki_Tests;
      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Parsers.Wiki_Syntax_Type;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access;

      Result_Dir  : constant String := "regtests/result";
      Expect_Dir  : constant String := "regtests/expect";
      Expect_Path : constant String := Util.Tests.Get_Path (Expect_Dir);
      Result_Path : constant String := Util.Tests.Get_Test_Path (Result_Dir);
      Search      : Search_Type;
      Filter      : constant Filter_Type := (others => True);
      Ent         : Directory_Entry_Type;

      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Parsers.Wiki_Syntax_Type;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access is
         Tst    : Test_Case_Access;
      begin
         Tst := new Test;
         Tst.Is_Html := Is_Html;
         Tst.Name    := To_Unbounded_String (Name);
         Tst.File    := To_Unbounded_String (Path);
         Tst.Expect  := To_Unbounded_String (Expect_Path & Prefix & Name);
         Tst.Result  := To_Unbounded_String (Result_Path & Prefix & Name);
         Tst.Format  := Format;
         Tst.Source  := Format;
         return Tst;
      end Create_Test;

      procedure Add_Wiki_Tests is
         Dir         : constant String := "regtests/files/wiki";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Ext    : constant String := Ada.Directories.Extension (Simple);
               Tst    : Test_Case_Access;
               Format : Wiki.Parsers.Wiki_Syntax_Type;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  if Ext = "wiki" then
                     Format := Wiki.Parsers.SYNTAX_GOOGLE;
                  elsif Ext = "dotclear" then
                     Format := Wiki.Parsers.SYNTAX_DOTCLEAR;
                  elsif Ext = "creole" then
                     Format := Wiki.Parsers.SYNTAX_CREOLE;
                  elsif Ext = "phpbb" then
                     Format := Wiki.Parsers.SYNTAX_PHPBB;
                  elsif Ext = "mediawiki" then
                     Format := Wiki.Parsers.SYNTAX_MEDIA_WIKI;
                  else
                     Format := Wiki.Parsers.SYNTAX_MIX;
                  end if;

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-html/", True);
                  Suite.Add_Test (Tst.all'Access);

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-txt/", False);
                  Suite.Add_Test (Tst.all'Access);
               end if;
            end;
         end loop;
      end Add_Wiki_Tests;

      procedure Add_Import_Tests is
         Dir         : constant String := "regtests/files/html";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Name   : constant String := Base_Name (Simple);
               Tst    : Test_Case_Access;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  for Syntax in Wiki.Parsers.Wiki_Syntax_Type'Range loop
                     case Syntax is
                        when Wiki.Parsers.SYNTAX_CREOLE =>
                           Tst := Create_Test (Name & ".creole", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.Parsers.SYNTAX_DOTCLEAR =>
                           Tst := Create_Test (Name & ".dotclear", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.Parsers.SYNTAX_MEDIA_WIKI =>
                           Tst := Create_Test (Name & ".mediawiki", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when others =>
                           Tst := null;

                     end case;
                     if Tst /= null then
                        Tst.Source := Wiki.Parsers.SYNTAX_HTML;
                        Suite.Add_Test (Tst.all'Access);
                     end if;
                  end loop;
               end if;
            end;
         end loop;
      end Add_Import_Tests;

   begin
      Add_Wiki_Tests;
      Add_Import_Tests;
   end Add_Tests;

end Wiki.Tests;

-----------------------------------------------------------------------
--  Render Tests - Unit tests for AWA Wiki rendering
--  Copyright (C) 2013, 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 Ada.Text_IO;
with Ada.Directories;
with Ada.Characters.Conversions;

with Util.Files;
with Util.Measures;

with Wiki.Render.Wiki;
with Wiki.Filters.Html;
with Wiki.Streams.Html.Builders;
with Wiki.Streams.Builders;
with Wiki.Utils;
with Wiki.Nodes;
package body Wiki.Tests is

   use Ada.Strings.Unbounded;
   use type Wiki.Parsers.Wiki_Syntax_Type;

   --  ------------------------------
   --  Test rendering a wiki text in HTML or text.
   --  ------------------------------
   procedure Test_Render (T : in out Test) is
      function To_Wide (Item : in String) return Wide_Wide_String
        renames Ada.Characters.Conversions.To_Wide_Wide_String;

      Result_File : constant String := To_String (T.Result);
      Content     : Unbounded_String;
   begin
      Util.Files.Read_File (Path     => To_String (T.File),
                            Into     => Content,
                            Max_Size => 10000);
      declare
         Time : Util.Measures.Stamp;
      begin
         if T.Source = Wiki.Parsers.SYNTAX_HTML then
            declare
               Html_Filter : aliased Wiki.Filters.Html.Html_Filter_Type;
               Writer      : aliased Wiki.Streams.Builders.Output_Builder_Stream;
               Renderer    : aliased Wiki.Render.Wiki.Wiki_Renderer;
               Doc         : Wiki.Nodes.Document;
               Engine      : Wiki.Parsers.Parser;
            begin
               Renderer.Set_Output_Stream (Writer'Unchecked_Access, T.Format);
               Engine.Add_Filter (Html_Filter'Unchecked_Access);
               Engine.Set_Syntax (Wiki.Parsers.SYNTAX_HTML);
               Engine.Parse (To_Wide (To_String (Content)), Doc);
               Renderer.Render (Doc);
               Content := To_Unbounded_String (Writer.To_String);
            end;
         elsif T.Is_Html then
            Content := To_Unbounded_String
              (Utils.To_Html (To_Wide (To_String (Content)), T.Format));
         else
            Content := To_Unbounded_String
              (Utils.To_Text (To_Wide (To_String (Content)), T.Format));
         end if;

         Util.Measures.Report (Time, "Render " & To_String (T.Name));
      end;

      Util.Files.Write_File (Result_File, Content);
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => To_String (T.Expect),
                                     Test    => Result_File,
                                     Message => "Render");
   end Test_Render;

   --  ------------------------------
   --  Test case name
   --  ------------------------------
   overriding
   function Name (T : in Test) return Util.Tests.Message_String is
   begin
      if T.Source = Wiki.Parsers.SYNTAX_HTML then
         return Util.Tests.Format ("Test IMPORT " & To_String (T.Name));
      elsif T.Is_Html then
         return Util.Tests.Format ("Test HTML " & To_String (T.Name));
      else
         return Util.Tests.Format ("Test TEXT " & To_String (T.Name));
      end if;
   end Name;

   --  ------------------------------
   --  Perform the test.
   --  ------------------------------
   overriding
   procedure Run_Test (T : in out Test) is
   begin
      T.Test_Render;
   end Run_Test;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
      use Ada.Directories;

      procedure Add_Import_Tests;
      procedure Add_Wiki_Tests;
      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Parsers.Wiki_Syntax_Type;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access;

      Result_Dir  : constant String := "regtests/result";
      Expect_Dir  : constant String := "regtests/expect";
      Expect_Path : constant String := Util.Tests.Get_Path (Expect_Dir);
      Result_Path : constant String := Util.Tests.Get_Test_Path (Result_Dir);
      Search      : Search_Type;
      Filter      : constant Filter_Type := (others => True);
      Ent         : Directory_Entry_Type;

      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Parsers.Wiki_Syntax_Type;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access is
         Tst    : Test_Case_Access;
      begin
         Tst := new Test;
         Tst.Is_Html := Is_Html;
         Tst.Name    := To_Unbounded_String (Name);
         Tst.File    := To_Unbounded_String (Path);
         Tst.Expect  := To_Unbounded_String (Expect_Path & Prefix & Name);
         Tst.Result  := To_Unbounded_String (Result_Path & Prefix & Name);
         Tst.Format  := Format;
         Tst.Source  := Format;
         return Tst;
      end Create_Test;

      procedure Add_Wiki_Tests is
         Dir         : constant String := "regtests/files/wiki";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Ext    : constant String := Ada.Directories.Extension (Simple);
               Tst    : Test_Case_Access;
               Format : Wiki.Parsers.Wiki_Syntax_Type;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  if Ext = "wiki" then
                     Format := Wiki.Parsers.SYNTAX_GOOGLE;
                  elsif Ext = "dotclear" then
                     Format := Wiki.Parsers.SYNTAX_DOTCLEAR;
                  elsif Ext = "creole" then
                     Format := Wiki.Parsers.SYNTAX_CREOLE;
                  elsif Ext = "phpbb" then
                     Format := Wiki.Parsers.SYNTAX_PHPBB;
                  elsif Ext = "mediawiki" then
                     Format := Wiki.Parsers.SYNTAX_MEDIA_WIKI;
                  else
                     Format := Wiki.Parsers.SYNTAX_MIX;
                  end if;

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-html/", True);
                  Suite.Add_Test (Tst.all'Access);

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-txt/", False);
                  Suite.Add_Test (Tst.all'Access);
               end if;
            end;
         end loop;
      end Add_Wiki_Tests;

      procedure Add_Import_Tests is
         Dir         : constant String := "regtests/files/html";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Name   : constant String := Base_Name (Simple);
               Tst    : Test_Case_Access;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  for Syntax in Wiki.Parsers.Wiki_Syntax_Type'Range loop
                     case Syntax is
                        when Wiki.Parsers.SYNTAX_CREOLE =>
                           Tst := Create_Test (Name & ".creole", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.Parsers.SYNTAX_DOTCLEAR =>
                           Tst := Create_Test (Name & ".dotclear", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.Parsers.SYNTAX_MEDIA_WIKI =>
                           Tst := Create_Test (Name & ".mediawiki", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when others =>
                           Tst := null;

                     end case;
                     if Tst /= null then
                        Tst.Source := Wiki.Parsers.SYNTAX_HTML;
                        Suite.Add_Test (Tst.all'Access);
                     end if;
                  end loop;
               end if;
            end;
         end loop;
      end Add_Import_Tests;

   begin
      Add_Wiki_Tests;
      Add_Import_Tests;
   end Add_Tests;

end Wiki.Tests;

Update the Wiki to Wiki generation for the test


-----------------------------------------------------------------------
--  mat-readers-tests -- Unit tests for MAT readers
--  Copyright (C) 2014, 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 Util.Test_Caller;

with MAT.Readers.Streams.Files;
package body MAT.Readers.Tests is

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test MAT.Readers.Read_File",
                       Test_Read_File'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test reading a file into a string
   --  Reads this ada source file and checks we have read it correctly
   --  ------------------------------
   procedure Test_Read_File (T : in out Test) is
      pragma Unreferenced (T);

      Path   : constant String := Util.Tests.Get_Test_Path ("regtests/files/file-v1.dat");
      Reader : MAT.Readers.Streams.Files.File_Reader_Type;
   begin
      Reader.Open (Path);
      Reader.Read_All;
   end Test_Read_File;

end MAT.Readers.Tests;

-----------------------------------------------------------------------
--  mat-readers-tests -- Unit tests for MAT readers
--  Copyright (C) 2014, 2019, 2021 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 MAT.Readers.Streams.Files;
package body MAT.Readers.Tests is

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test MAT.Readers.Read_File",
                       Test_Read_File'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test reading a file into a string
   --  Reads this ada source file and checks we have read it correctly
   --  ------------------------------
   procedure Test_Read_File (T : in out Test) is
      pragma Unreferenced (T);

      Path   : constant String := Util.Tests.Get_Path ("regtests/files/file-v1.dat");
      Reader : MAT.Readers.Streams.Files.File_Reader_Type;
   begin
      Reader.Open (Path);
      Reader.Read_All;
   end Test_Read_File;

end MAT.Readers.Tests;

Replace Get_Test_Path by Get_Path

Replace Get_Test_Path by Get_Path


-- @file coverage_for_ada_task.adb
-- @date 28 May 2022
-- @author Chester Gillon
-- @brief Example program to test getting coverage for an Ada task

with Ada.Text_IO;

procedure Coverage_For_Ada_Task is
   task Print_Task is
      entry Print;
   end Print_Task;

   task body Print_Task is
   begin
      loop
         select
            accept Print do
               Ada.Text_IO.Put_Line ("In task Print_Task");
            end Print;
         or
            terminate;
         end select;
      end loop;
   end Print_Task;
begin
   for index in 1..3
   loop
      Print_Task.Print;
   end loop;
   Ada.Text_IO.Put_Line ("In main");
end Coverage_For_Ada_Task;

-- @file coverage_for_ada_task.adb
-- @date 28 May 2022
-- @author Chester Gillon
-- @brief Example program to test getting coverage for an Ada task

with Ada.Text_IO;

procedure Coverage_For_Ada_Task is
   generic
      Name : String;
   package Generic_Name is
      procedure Display_Name;
   end Generic_Name;

   package body Generic_Name is
      procedure Display_Name is
      begin
         Ada.Text_IO.Put_Line ("My name is " & Name);
      end Display_Name;
   end Generic_Name;

   task Print_Task is
      entry Print;
   end Print_Task;

   task body Print_Task is
   begin
      loop
         select
            accept Print do
               Ada.Text_IO.Put_Line ("In task Print_Task");
            end Print;
         or
            terminate;
         end select;
      end loop;
   end Print_Task;

   package Package_A is new Generic_Name ("A");
   package Package_B is new Generic_Name ("B");
begin
   Package_A.Display_Name;
   for index in 1..3
   loop
      Print_Task.Print;
   end loop;
   Package_B.Display_Name;
   Ada.Text_IO.Put_Line ("In main");
end Coverage_For_Ada_Task;

Add coverage test for simple generic package


-----------------------------------------------------------------------
--  security-policies -- Security Policies
--  Copyright (C) 2010, 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 Ada.Finalization;

with Util.Beans.Objects;
with Util.Beans.Objects.Vectors;
with Util.Serialize.IO.XML;
with Util.Strings;

with Security.Permissions;
limited with Security.Controllers;
limited with Security.Contexts;

package Security.Policies is

   type Security_Context_Access is access all Contexts.Security_Context'Class;

   type Controller_Access is access all Security.Controllers.Controller'Class;

   type Controller_Access_Array is array (Permissions.Permission_Index range <>) of Controller_Access;

   type Policy is new Ada.Finalization.Limited_Controlled with private;
   type Policy_Access is access all Policy'Class;

   procedure Set_Reader_Config (Pol     : in out Policy;
                                Reader  : in out Util.Serialize.IO.XML.Parser) is null;

   --  Get the policy name.
   function Get_Name (From : in Policy) return String;

   --  Add a permission under the given permission name and associated with the controller.
   --  To verify the permission, the controller will be called.
   procedure Add_Permission (Manager    : in out Policy;
                             Name       : in String;
                             Permission : in Controller_Access);

   Invalid_Name : exception;

   Policy_Error : exception;

   --  Each permission is represented by a Permission_Type number to provide a fast
   --  and efficient permission check.
   type Permission_Type is new Natural range 0 .. 63;

   --  The Permission_Map represents a set of permissions which are granted to a user.
   --  Each permission is represented by a boolean in the map.  The implementation is limited
   --  to 64 permissions.
   type Permission_Map is array (Permission_Type'Range) of Boolean;
   pragma Pack (Permission_Map);

   --  ------------------------------
   --  Permission Manager
   --  ------------------------------
   --  The Permission_Manager verifies through some policy that a permission
   --  is granted to a user.
   type Policy_Manager (Max_Policies : Positive) is
     new Ada.Finalization.Limited_Controlled with private;
   type Policy_Manager_Access is access all Policy_Manager'Class;

   --  Add the policy to the policy manager.  After a policy is added in the manager,
   --  it can participate in the security policy.
   --  Raises Policy_Error if the policy table is full.
   procedure Add_Policy (Manager : in out Policy_Manager;
                         Policy  : in Policy_Access);

   --  Add a permission under the given permission name and associated with the controller.
   --  To verify the permission, the controller will be called.
   procedure Add_Permission (Manager    : in out Policy_Manager;
                             Name       : in String;
                             Permission : in Controller_Access);

   --  Get the security controller associated with the permission index Index.
   --  Returns null if there is no such controller.
   function Get_Controller (Manager : in Policy_Manager'Class;
                            Index   : in Permissions.Permission_Index) return Controller_Access;
   pragma Inline_Always (Get_Controller);

   --  Read the policy file
   procedure Read_Policy (Manager : in out Policy_Manager;
                          File    : in String);

   --  Initialize the permission manager.
   overriding
   procedure Initialize (Manager : in out Policy_Manager);

   --  Finalize the permission manager.
   overriding
   procedure Finalize (Manager : in out Policy_Manager);

   --  ------------------------------
   --  Policy Configuration
   --  ------------------------------
   type Policy_Config is record
      Id          : Natural := 0;
      Permissions : Util.Beans.Objects.Vectors.Vector;
      Patterns    : Util.Beans.Objects.Vectors.Vector;
      Manager     : Policy_Manager_Access;
   end record;
   type Policy_Config_Access is access all Policy_Config;

   --  Setup the XML parser to read the policy description.  For example:
   --
   --  <policy id='1'>
   --     <permission>create-workspace</permission>
   --     <permission>admin</permission>
   --     <url-pattern>/workspace/create</url-pattern>
   --     <url-pattern>/workspace/setup/*</url-pattern>
   --  </policy>
   --
   --  This policy gives access to the URL that match one of the URL pattern if the
   --  security context has the permission create-workspace or admin.
   generic
      Reader  : in out Util.Serialize.IO.XML.Parser;
      Manager : in Policy_Manager_Access;
   package Reader_Config is
      Config : aliased Policy_Config;
   end Reader_Config;

private

   use Util.Strings;

   subtype Permission_Index is Permissions.Permission_Index;

   type Permission_Type_Array is array (1 .. 10) of Permission_Type;

   type Permission_Index_Array is array (Positive range <>) of Permissions.Permission_Index;

   type Controller_Access_Array_Access is access all Controller_Access_Array;

   type Policy_Access_Array is array (Positive range <>) of Policy_Access;

   type Policy is new Ada.Finalization.Limited_Controlled with record
      Manager : Policy_Manager_Access;
   end record;

   type Policy_Manager (Max_Policies : Positive) is
     new Ada.Finalization.Limited_Controlled with record
--        Cache        : Rules_Ref_Access;
--        Policies     : Policy_Vector.Vector;
      Permissions  : Controller_Access_Array_Access;
      Last_Index   : Permission_Index := Permission_Index'First;

      --  The security policies.
      Policies     : Policy_Access_Array (1 .. Max_Policies);
   end record;

end Security.Policies;

-----------------------------------------------------------------------
--  security-policies -- Security Policies
--  Copyright (C) 2010, 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 Ada.Finalization;

with Util.Beans.Objects;
with Util.Beans.Objects.Vectors;
with Util.Serialize.IO.XML;
with Util.Strings;

with Security.Permissions;
limited with Security.Controllers;
limited with Security.Contexts;

package Security.Policies is

   type Security_Context_Access is access all Contexts.Security_Context'Class;

   type Controller_Access is access all Security.Controllers.Controller'Class;

   type Controller_Access_Array is array (Permissions.Permission_Index range <>) of Controller_Access;

   type Policy is new Ada.Finalization.Limited_Controlled with private;
   type Policy_Access is access all Policy'Class;

   procedure Set_Reader_Config (Pol     : in out Policy;
                                Reader  : in out Util.Serialize.IO.XML.Parser) is null;

   --  Get the policy name.
   function Get_Name (From : in Policy) return String;

   --  Add a permission under the given permission name and associated with the controller.
   --  To verify the permission, the controller will be called.
   procedure Add_Permission (Manager    : in out Policy;
                             Name       : in String;
                             Permission : in Controller_Access);

   Invalid_Name : exception;

   Policy_Error : exception;

   --  ------------------------------
   --  Permission Manager
   --  ------------------------------
   --  The Permission_Manager verifies through some policy that a permission
   --  is granted to a user.
   type Policy_Manager (Max_Policies : Positive) is
     new Ada.Finalization.Limited_Controlled with private;
   type Policy_Manager_Access is access all Policy_Manager'Class;

   --  Add the policy to the policy manager.  After a policy is added in the manager,
   --  it can participate in the security policy.
   --  Raises Policy_Error if the policy table is full.
   procedure Add_Policy (Manager : in out Policy_Manager;
                         Policy  : in Policy_Access);

   --  Add a permission under the given permission name and associated with the controller.
   --  To verify the permission, the controller will be called.
   procedure Add_Permission (Manager    : in out Policy_Manager;
                             Name       : in String;
                             Permission : in Controller_Access);

   --  Get the security controller associated with the permission index Index.
   --  Returns null if there is no such controller.
   function Get_Controller (Manager : in Policy_Manager'Class;
                            Index   : in Permissions.Permission_Index) return Controller_Access;
   pragma Inline_Always (Get_Controller);

   --  Read the policy file
   procedure Read_Policy (Manager : in out Policy_Manager;
                          File    : in String);

   --  Initialize the permission manager.
   overriding
   procedure Initialize (Manager : in out Policy_Manager);

   --  Finalize the permission manager.
   overriding
   procedure Finalize (Manager : in out Policy_Manager);

   --  ------------------------------
   --  Policy Configuration
   --  ------------------------------
   type Policy_Config is record
      Id          : Natural := 0;
      Permissions : Util.Beans.Objects.Vectors.Vector;
      Patterns    : Util.Beans.Objects.Vectors.Vector;
      Manager     : Policy_Manager_Access;
   end record;
   type Policy_Config_Access is access all Policy_Config;

   --  Setup the XML parser to read the policy description.  For example:
   --
   --  <policy id='1'>
   --     <permission>create-workspace</permission>
   --     <permission>admin</permission>
   --     <url-pattern>/workspace/create</url-pattern>
   --     <url-pattern>/workspace/setup/*</url-pattern>
   --  </policy>
   --
   --  This policy gives access to the URL that match one of the URL pattern if the
   --  security context has the permission create-workspace or admin.
   generic
      Reader  : in out Util.Serialize.IO.XML.Parser;
      Manager : in Policy_Manager_Access;
   package Reader_Config is
      Config : aliased Policy_Config;
   end Reader_Config;

private

   use Util.Strings;

   subtype Permission_Index is Permissions.Permission_Index;

   type Permission_Index_Array is array (Positive range <>) of Permissions.Permission_Index;

   type Controller_Access_Array_Access is access all Controller_Access_Array;

   type Policy_Access_Array is array (Positive range <>) of Policy_Access;

   type Policy is new Ada.Finalization.Limited_Controlled with record
      Manager : Policy_Manager_Access;
   end record;

   type Policy_Manager (Max_Policies : Positive) is
     new Ada.Finalization.Limited_Controlled with record
--        Cache        : Rules_Ref_Access;
--        Policies     : Policy_Vector.Vector;
      Permissions  : Controller_Access_Array_Access;
      Last_Index   : Permission_Index := Permission_Index'First;

      --  The security policies.
      Policies     : Policy_Access_Array (1 .. Max_Policies);
   end record;

end Security.Policies;

Remove unused type definitions

Remove unused type definitions


-----------------------------------------------------------------------
--  awa-setup -- Setup and installation
--  Copyright (C) 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 Ada.Strings.Unbounded;
with ASF.Applications.Main;
with ASF.Servlets.Faces;
with ASF.Servlets.Files;
with ASF.Server;
with Util.Beans.Objects;
with Util.Beans.Basic;
with Util.Beans.Methods;
with ADO.Drivers.Connections;
package AWA.Setup.Applications is

   type Application is new ASF.Applications.Main.Application and Util.Beans.Basic.Bean
     and Util.Beans.Methods.Method_Bean with record
      Faces    : aliased ASF.Servlets.Faces.Faces_Servlet;
      Files    : aliased ASF.Servlets.Files.File_Servlet;
      Config   : ASF.Applications.Config;
      Changed  : ASF.Applications.Config;
      Factory  : ASF.Applications.Main.Application_Factory;
      Path     : Ada.Strings.Unbounded.Unbounded_String;
      Database : ADO.Drivers.Connections.Configuration;
      Done     : Boolean := False;
      pragma Atomic (Done);
      pragma Volatile (Done);
   end record;

   --  Get the value identified by the name.
   function Get_Value (From : in Application;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   procedure Set_Value (From  : in out Application;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Configure the database.
   procedure Configure_Database (From    : in out Application;
                                 Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Save the configuration.
   procedure Save (From    : in out Application;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Finish the setup and exit the setup.
   procedure Finish (From    : in out Application;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  This bean provides some methods that can be used in a Method_Expression
   overriding
   function Get_Method_Bindings (From : in Application)
                                 return Util.Beans.Methods.Method_Binding_Array_Access;

   --  Enter in the application setup
   procedure Setup (App    : in out Application;
                    Config : in String;
                    Server : in out ASF.Server.Container'Class);

end AWA.Setup.Applications;

-----------------------------------------------------------------------
--  awa-setup -- Setup and installation
--  Copyright (C) 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 Ada.Strings.Unbounded;
with ASF.Applications.Main;
with ASF.Servlets.Faces;
with ASF.Servlets.Files;
with ASF.Server;
with Util.Beans.Objects;
with Util.Beans.Basic;
with Util.Beans.Methods;
with ADO.Drivers.Connections;
package AWA.Setup.Applications is

   type Application is new ASF.Applications.Main.Application and Util.Beans.Basic.Bean
     and Util.Beans.Methods.Method_Bean with record
      Faces    : aliased ASF.Servlets.Faces.Faces_Servlet;
      Files    : aliased ASF.Servlets.Files.File_Servlet;
      Config   : ASF.Applications.Config;
      Changed  : ASF.Applications.Config;
      Factory  : ASF.Applications.Main.Application_Factory;
      Path     : Ada.Strings.Unbounded.Unbounded_String;
      Database : ADO.Drivers.Connections.Configuration;
      Done     : Boolean := False;
      pragma Atomic (Done);
      pragma Volatile (Done);
   end record;

   --  Get the value identified by the name.
   function Get_Value (From : in Application;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   procedure Set_Value (From  : in out Application;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Get the database connection string to be used by the application.
   function Get_Database_URL (From : in Application) return String;

   --  Configure the database.
   procedure Configure_Database (From    : in out Application;
                                 Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Save the configuration.
   procedure Save (From    : in out Application;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Finish the setup and exit the setup.
   procedure Finish (From    : in out Application;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  This bean provides some methods that can be used in a Method_Expression
   overriding
   function Get_Method_Bindings (From : in Application)
                                 return Util.Beans.Methods.Method_Binding_Array_Access;

   --  Enter in the application setup
   procedure Setup (App    : in out Application;
                    Config : in String;
                    Server : in out ASF.Server.Container'Class);

end AWA.Setup.Applications;

Declare the Get_Database_URL function

Declare the Get_Database_URL function