-----------------------------------------------------------------------
--  awa-images-beans -- Image Ada Beans
--  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 ADO;

with Util.Beans.Objects;
with Util.Beans.Basic;
with AWA.Storages.Beans;
with AWA.Images.Models;
with AWA.Images.Modules;
package AWA.Images.Beans is

   --  ------------------------------
   --  Image List Bean
   --  ------------------------------
   --  This bean represents a list of images for a given folder.
   type Image_List_Bean is new AWA.Storages.Beans.Storage_List_Bean with record

      --  List of images.
      Image_List       : aliased AWA.Images.Models.Image_Info_List_Bean;
      Image_List_Bean  : AWA.Images.Models.Image_Info_List_Bean_Access;
   end record;
   type Image_List_Bean_Access is access all Image_List_Bean'Class;

   --  Load the list of images associated with the current folder.
   overriding
   procedure Load_Files (Storage : in Image_List_Bean);

   overriding
   function Get_Value (List : in Image_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Create the Image_List_Bean bean instance.
   function Create_Image_List_Bean (Module : in AWA.Images.Modules.Image_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Images.Beans;

-----------------------------------------------------------------------
--  awa-images-beans -- Image Ada Beans
--  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 ADO;

with Util.Beans.Objects;
with Util.Beans.Basic;
with AWA.Storages.Beans;
with AWA.Images.Models;
with AWA.Images.Modules;
package AWA.Images.Beans is

   --  ------------------------------
   --  Image List Bean
   --  ------------------------------
   --  This bean represents a list of images for a given folder.
   type Image_List_Bean is new AWA.Storages.Beans.Storage_List_Bean with record

      --  List of images.
      Image_List       : aliased AWA.Images.Models.Image_Info_List_Bean;
      Image_List_Bean  : AWA.Images.Models.Image_Info_List_Bean_Access;
   end record;
   type Image_List_Bean_Access is access all Image_List_Bean'Class;

   --  Load the list of images associated with the current folder.
   overriding
   procedure Load_Files (Storage : in Image_List_Bean);

   overriding
   function Get_Value (List : in Image_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Create the Image_List_Bean bean instance.
   function Create_Image_List_Bean (Module : in AWA.Images.Modules.Image_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

   type Image_Bean is new AWA.Images.Models.Image_Bean with record
      Module : AWA.Images.Modules.Image_Module_Access;
   end record;
   type Image_Bean_Access is access all Image_Bean'Class;

   overriding
   procedure Load (Into    : in out Image_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Image_Bean bean instance.
   function Create_Image_Bean (Module : in AWA.Images.Modules.Image_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Images.Beans;

Define the Image_Bean type with the Load operation


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

with Ada.Text_IO;
with Ada.Calendar;
with Ada.Unchecked_Deallocation;

with Util.Test_Caller;
package body ASF.Contexts.Writer.Tests is

   use Util.Tests;

   procedure Free_Writer is
     new Ada.Unchecked_Deallocation (Object => Test_Writer'Class,
                                     Name   => Test_Writer_Access);

   procedure Initialize (Stream       : in out Test_Writer;
                         Content_Type : in String;
                         Encoding     : in String;
                         Size         : in Natural) is
      Output : ASF.Streams.Print_Stream;
   begin
      Stream.Content.Initialize (Size => Size);
      Output.Initialize (Stream.Content'Unchecked_Access);
      Stream.Initialize (Content_Type, Encoding, Output);
   end Initialize;

   overriding
   procedure Write (Stream : in out Test_Writer;
                    Buffer : in Ada.Streams.Stream_Element_Array) is
   begin
      for I in Buffer'Range loop
         Append (Stream.Response, Character'Val (Buffer (I)));
      end loop;
   end Write;

   overriding
   procedure Flush (Stream : in out Test_Writer) is
   begin
      Response_Writer (Stream).Flush;
      Stream.Content.Read (Into => Stream.Response);
   end Flush;

   --  Set up performed before each test case
   overriding
   procedure Set_Up (T : in out Test) is
   begin
      T.Writer := new Test_Writer;
      --  use a small buffer to test the flush
      T.Writer.Initialize ("text/xml", "UTF-8", 1024);
   end Set_Up;

   --  Tear down performed after each test case
   overriding
   procedure Tear_Down (T : in out Test) is
   begin
      Free_Writer (T.Writer);
   end Tear_Down;

   --  Test the Start/Write/End_Element methods
   procedure Test_Write_Element (T : in out Test) is
   begin
      T.Writer.Start_Element ("p");
      T.Writer.Start_Element ("b");
      T.Writer.Write_Element ("i", "italic within a bold");
      T.Writer.End_Element ("b");
      T.Writer.End_Element ("p");
      T.Writer.Flush;

      Assert_Equals (T, "
italic within a bold
",
                     T.Writer.Response);

      T.Writer.Response := To_Unbounded_String ("");
      T.Writer.Start_Element ("div");
      T.Writer.Write_Attribute ("title", "A ""S&'%^&<>");
      T.Writer.Write_Attribute ("id", "23");
      T.Writer.End_Element ("div");
      T.Writer.Flush;

      Assert_Equals (T, "

",
                     T.Writer.Response);
   end Test_Write_Element;

   --  Test the Write_Char/Text methods
   procedure Test_Write_Text (T : in out Test) is
      use Ada.Calendar;
      Start : Ada.Calendar.Time;
      D     : Duration;
   begin
      Start := Ada.Calendar.Clock;
      T.Writer.Start_Element ("p");
      T.Writer.Write_Char ('<');
      T.Writer.Write_Char ('>');
      T.Writer.Write_Char ('~');
      T.Writer.Start_Element ("i");
      T.Writer.Write_Text ("""A' <>&");
      T.Writer.End_Element ("i");
      T.Writer.End_Element ("p");
      T.Writer.Flush;
      D := Ada.Calendar.Clock - Start;
      Ada.Text_IO.Put_Line ("Write text: " & Duration'Image (D));

      Assert_Equals (T, "
<>~""A' <>&
",
                     T.Writer.Response);
   end Test_Write_Text;

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

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

   begin
      --  To document what is tested, register the test methods for each
      --  operation that is tested.
      Caller.Add_Test (Suite, "Test ASF.Contexts.Writer.Start_Element",
                       Test_Write_Element'Access);
      Caller.Add_Test (Suite, "Test ASF.Contexts.Writer.End_Element",
                       Test_Write_Element'Access);

      Caller.Add_Test (Suite, "Test ASF.Contexts.Writer.Write_Element",
                       Test_Write_Element'Access);

      Caller.Add_Test (Suite, "Test ASF.Contexts.Writer.Write_Attribute",
                       Test_Write_Element'Access);

      Caller.Add_Test (Suite, "Test ASF.Contexts.Writer.Write_Text",
                       Test_Write_Text'Access);

      Caller.Add_Test (Suite, "Test ASF.Contexts.Writer.Write_Char",
                       Test_Write_Text'Access);
   end Add_Tests;

end ASF.Contexts.Writer.Tests;

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

with Ada.Text_IO;
with Ada.Calendar;
with Ada.Unchecked_Deallocation;

with Util.Test_Caller;
package body ASF.Contexts.Writer.Tests is

   use Util.Tests;

   procedure Free_Writer is
     new Ada.Unchecked_Deallocation (Object => Test_Writer'Class,
                                     Name   => Test_Writer_Access);

   procedure Initialize (Stream       : in out Test_Writer;
                         Content_Type : in String;
                         Encoding     : in String;
                         Size         : in Natural) is
      Output : ASF.Streams.Print_Stream;
   begin
      Stream.Content.Initialize (Size => Size);
      Output.Initialize (Stream.Content'Unchecked_Access);
      Stream.Initialize (Content_Type, Encoding, Output);
   end Initialize;

   overriding
   procedure Write (Stream : in out Test_Writer;
                    Buffer : in Ada.Streams.Stream_Element_Array) is
   begin
      for I in Buffer'Range loop
         Append (Stream.Response, Character'Val (Buffer (I)));
      end loop;
   end Write;

   overriding
   procedure Flush (Stream : in out Test_Writer) is
   begin
      Response_Writer (Stream).Flush;
      Stream.Content.Flush (Into => Stream.Response);
   end Flush;

   --  Set up performed before each test case
   overriding
   procedure Set_Up (T : in out Test) is
   begin
      T.Writer := new Test_Writer;
      --  use a small buffer to test the flush
      T.Writer.Initialize ("text/xml", "UTF-8", 1024);
   end Set_Up;

   --  Tear down performed after each test case
   overriding
   procedure Tear_Down (T : in out Test) is
   begin
      Free_Writer (T.Writer);
   end Tear_Down;

   --  Test the Start/Write/End_Element methods
   procedure Test_Write_Element (T : in out Test) is
   begin
      T.Writer.Start_Element ("p");
      T.Writer.Start_Element ("b");
      T.Writer.Write_Element ("i", "italic within a bold");
      T.Writer.End_Element ("b");
      T.Writer.End_Element ("p");
      T.Writer.Flush;

      Assert_Equals (T, "
italic within a bold
",
                     T.Writer.Response);

      T.Writer.Response := To_Unbounded_String ("");
      T.Writer.Start_Element ("div");
      T.Writer.Write_Attribute ("title", "A ""S&'%^&<>");
      T.Writer.Write_Attribute ("id", "23");
      T.Writer.End_Element ("div");
      T.Writer.Flush;

      Assert_Equals (T, "

",
                     T.Writer.Response);
   end Test_Write_Element;

   --  Test the Write_Char/Text methods
   procedure Test_Write_Text (T : in out Test) is
      use Ada.Calendar;
      Start : Ada.Calendar.Time;
      D     : Duration;
   begin
      Start := Ada.Calendar.Clock;
      T.Writer.Start_Element ("p");
      T.Writer.Write_Char ('<');
      T.Writer.Write_Char ('>');
      T.Writer.Write_Char ('~');
      T.Writer.Start_Element ("i");
      T.Writer.Write_Text ("""A' <>&");
      T.Writer.End_Element ("i");
      T.Writer.End_Element ("p");
      T.Writer.Flush;
      D := Ada.Calendar.Clock - Start;
      Ada.Text_IO.Put_Line ("Write text: " & Duration'Image (D));

      Assert_Equals (T, "
<>~""A' <>&
",
                     T.Writer.Response);
   end Test_Write_Text;

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

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

   begin
      --  To document what is tested, register the test methods for each
      --  operation that is tested.
      Caller.Add_Test (Suite, "Test ASF.Contexts.Writer.Start_Element",
                       Test_Write_Element'Access);
      Caller.Add_Test (Suite, "Test ASF.Contexts.Writer.End_Element",
                       Test_Write_Element'Access);

      Caller.Add_Test (Suite, "Test ASF.Contexts.Writer.Write_Element",
                       Test_Write_Element'Access);

      Caller.Add_Test (Suite, "Test ASF.Contexts.Writer.Write_Attribute",
                       Test_Write_Element'Access);

      Caller.Add_Test (Suite, "Test ASF.Contexts.Writer.Write_Text",
                       Test_Write_Text'Access);

      Caller.Add_Test (Suite, "Test ASF.Contexts.Writer.Write_Char",
                       Test_Write_Text'Access);
   end Add_Tests;

end ASF.Contexts.Writer.Tests;

Update to use the Flush operation of Output_Buffer_Stream to get the stream content


with OpenAL.ALC_Thin;

package OpenAL.Context is

  --
  -- Types
  --

  type Device_t  is private;
  type Context_t is private;

  Invalid_Device  : constant Device_t;
  Invalid_Context : constant Context_t;
  Null_Context    : constant Context_t;

  type Format_t is (Mono_8, Stereo_8, Mono_16, Stereo_16);

  --
  -- API
  --

  -- proc_map : alcOpenDevice
  function Open_Device
    (Specifier : in String) return Device_t;

  -- proc_map : alcOpenDevice
  function Open_Default_Device return Device_t;

  -- proc_map : alcCloseDevice
  function Close_Device
    (Device : in Device_t) return Boolean;

  -- proc_map : alcCreateContext
  function Create_Context
    (Device : in Device_t) return Context_t;

  -- proc_map : alcMakeContextCurrent
  function Make_Context_Current
    (Context : in Context_t) return Boolean;

  -- proc_map : alcProcessContext
  procedure Process_Context
    (Context : in Context_t);

  -- proc_map : alcSuspendContext
  procedure Suspend_Context
    (Context : in Context_t);

  -- proc_map : alcDestroyContext
  procedure Destroy_Context
    (Context : in Context_t);

  -- proc_map : alcGetCurrentContext
  function Get_Current_Context return Context_t;

  -- proc_map : alcGetContextsDevice
  function Get_Context_Device (Context : in Context_t) return Device_t;

  -- proc_map : alIsExtensionPresent
  function Is_Extension_Present
    (Device : in Device_t;
     Name   : in String) return Boolean;

private

  type Device_t is record
    Device_Data      : ALC_Thin.Device_t;
    Capture_Format : Format_t;
    Capture        : Boolean := False;
  end record;

  type Context_t is new ALC_Thin.Context_t;

  Invalid_Device  : constant Device_t  := Device_t'
    (Device_Data      => ALC_Thin.Invalid_Device,
     Capture_Format => Mono_8,
     Capture        => False);

  Invalid_Context : constant Context_t := Context_t (ALC_Thin.Invalid_Context);

  Null_Context    : constant Context_t := Invalid_Context;

end OpenAL.Context;

with OpenAL.ALC_Thin;

package OpenAL.Context is

  --
  -- Types
  --

  type Device_t  is private;
  type Context_t is private;

  Invalid_Device  : constant Device_t;
  Invalid_Context : constant Context_t;
  Null_Context    : constant Context_t;

  type Format_t is (Mono_8, Stereo_8, Mono_16, Stereo_16);

  --
  -- API
  --

  -- proc_map : alcOpenDevice
  function Open_Device
    (Specifier : in String) return Device_t;

  -- proc_map : alcOpenDevice
  function Open_Default_Device return Device_t;

  -- proc_map : alcCloseDevice
  function Close_Device
    (Device : in Device_t) return Boolean;

  -- proc_map : alcCreateContext
  function Create_Context
    (Device : in Device_t) return Context_t;

  -- proc_map : alcMakeContextCurrent
  function Make_Context_Current
    (Context : in Context_t) return Boolean;

  -- proc_map : alcProcessContext
  procedure Process_Context
    (Context : in Context_t);

  -- proc_map : alcSuspendContext
  procedure Suspend_Context
    (Context : in Context_t);

  -- proc_map : alcDestroyContext
  procedure Destroy_Context
    (Context : in Context_t);

  -- proc_map : alcGetCurrentContext
  function Get_Current_Context return Context_t;

  -- proc_map : alcGetContextsDevice
  function Get_Context_Device (Context : in Context_t) return Device_t;

  -- proc_map : alcIsExtensionPresent
  function Is_Extension_Present
    (Device : in Device_t;
     Name   : in String) return Boolean;

private

  type Device_t is record
    Device_Data      : ALC_Thin.Device_t;
    Capture_Format : Format_t;
    Capture        : Boolean := False;
  end record;

  type Context_t is new ALC_Thin.Context_t;

  Invalid_Device  : constant Device_t  := Device_t'
    (Device_Data      => ALC_Thin.Invalid_Device,
     Capture_Format => Mono_8,
     Capture        => False);

  Invalid_Context : constant Context_t := Context_t (ALC_Thin.Invalid_Context);

  Null_Context    : constant Context_t := Invalid_Context;

end OpenAL.Context;

Fix proc_map

Fix proc_map


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

with ASF.Server.Web;
with ASF.Applications;
with ASF.Applications.Main;
with ASF.Servlets.Faces;
with ASF.Servlets.Files;
with ASF.Servlets.Measures;
with ASF.Filters.Dump;

with Util.Beans.Objects;
with Util.Log.Loggers;

with Users;
with AWS.Net.SSL;
with ASF.Security.Servlets;
procedure Openid is

   use ASF.Applications;

   Log          : Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Openid");

   CONTEXT_PATH : constant String := "/openid";
   CONFIG_PATH  : constant String := "samples.properties";

   App          : aliased ASF.Applications.Main.Application;
   Factory      : ASF.Applications.Main.Application_Factory;
   C            : ASF.Applications.Config;

   --  Application servlets.
   Faces        : aliased ASF.Servlets.Faces.Faces_Servlet;
   Files        : aliased ASF.Servlets.Files.File_Servlet;
   Perf         : aliased ASF.Servlets.Measures.Measure_Servlet;
   Auth         : aliased ASF.Security.Servlets.Request_Auth_Servlet;
   Verify_Auth  : aliased ASF.Security.Servlets.Verify_Auth_Servlet;

   --  Debug filters.
   Dump         : aliased ASF.Filters.Dump.Dump_Filter;

   --  Web application server
   WS           : ASF.Server.Web.AWS_Container;
begin
   if not AWS.Net.SSL.Is_Supported then
      Log.Error ("SSL is not supported by AWS.");
      Log.Error ("SSL is required for the OpenID connector to connect to OpenID providers.");
      Log.Error ("Please, rebuild AWS with SSL support.");
      return;
   end if;
   begin
      C.Load_Properties (CONFIG_PATH);
      Util.Log.Loggers.Initialize (CONFIG_PATH);

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Log.Error ("Cannot read application configuration file {0}", CONFIG_PATH);

   end;
   App.Initialize (C, Factory);
   App.Register ("samplesMsg", "samples");
   App.Set_Global ("contextPath", "/openid");

   --  Declare a global bean to identify this sample from within the XHTML files.
   App.Set_Global ("sampleName", "openid");

   App.Set_Global ("version", "0.1");
   App.Set_Global ("user", Util.Beans.Objects.To_Object (Users.User'Access,
     Util.Beans.Objects.STATIC));

   --  Register the servlets and filters
   App.Add_Servlet (Name => "faces", Server => Faces'Unchecked_Access);
   App.Add_Servlet (Name => "files", Server => Files'Unchecked_Access);
   App.Add_Servlet (Name => "auth", Server => Auth'Unchecked_Access);
   App.Add_Servlet (Name => "verify-auth", Server => Verify_Auth'Unchecked_Access);
   App.Add_Servlet (Name => "perf", Server => Perf'Unchecked_Access);

   --  Register the filters
   App.Add_Filter (Name => "perf", Filter => Perf'Unchecked_Access);
   App.Add_Filter (Name => "dump", Filter => Dump'Unchecked_Access);

   --  Define servlet mappings
   App.Add_Mapping (Name => "faces", Pattern => "*.html");
   App.Add_Mapping (Name => "files", Pattern => "*.css");
   App.Add_Mapping (Name => "files", Pattern => "*.js");
   App.Add_Mapping (Name => "files", Pattern => "*.png");
   App.Add_Mapping (Name => "files", Pattern => "*.jpg");
   App.Add_Mapping (Name => "verify-auth", Pattern => "/auth/verify");
   App.Add_Mapping (Name => "auth", Pattern => "/auth/auth/*");
   App.Add_Mapping (Name => "perf", Pattern => "/statistics.xml");

   --  Install the debug filter.
   App.Add_Filter_Mapping (Name => "perf", Pattern => "*.html");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "*.html");

   App.Add_Filter_Mapping (Name => "perf", Pattern => "*.css");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "*.css");

   App.Add_Filter_Mapping (Name => "perf", Pattern => "*.png");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "*.png");

   App.Add_Filter_Mapping (Name => "perf", Pattern => "*.jpg");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "*.jpg");

   App.Add_Filter_Mapping (Name => "perf", Pattern => "/auth/verify");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "/auth/verify");

   App.Add_Filter_Mapping (Name => "perf", Pattern => "/auth/auth/*");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "/auth/auth/*");

   WS.Register_Application (CONTEXT_PATH, App'Unchecked_Access);

   Log.Info ("Connect you browser to: http://localhost:8080/openid/auth/login.html");
   WS.Start;

   delay 600.0;

   App.Close;
exception
   when E : others =>
      Ada.Text_IO.Put_Line ("Exception in server: " &
                            Ada.Exceptions.Exception_Name (E) & ": " &
                            Ada.Exceptions.Exception_Message (E));
end Openid;

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

with ASF.Server.Web;
with ASF.Applications;
with ASF.Applications.Main;
with ASF.Servlets.Faces;
with ASF.Servlets.Files;
with ASF.Servlets.Measures;
with ASF.Filters.Dump;

with Util.Beans.Objects;
with Util.Log.Loggers;

with Users;
with AWS.Net.SSL;
with ASF.Security.Servlets;
procedure Openid is

   use ASF.Applications;

   Log          : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Openid");

   CONTEXT_PATH : constant String := "/openid";
   CONFIG_PATH  : constant String := "samples.properties";

   App          : aliased ASF.Applications.Main.Application;
   Factory      : ASF.Applications.Main.Application_Factory;
   C            : ASF.Applications.Config;

   --  Application servlets.
   Faces        : aliased ASF.Servlets.Faces.Faces_Servlet;
   Files        : aliased ASF.Servlets.Files.File_Servlet;
   Perf         : aliased ASF.Servlets.Measures.Measure_Servlet;
   Auth         : aliased ASF.Security.Servlets.Request_Auth_Servlet;
   Verify_Auth  : aliased ASF.Security.Servlets.Verify_Auth_Servlet;

   --  Debug filters.
   Dump         : aliased ASF.Filters.Dump.Dump_Filter;

   --  Web application server
   WS           : ASF.Server.Web.AWS_Container;
begin
   if not AWS.Net.SSL.Is_Supported then
      Log.Error ("SSL is not supported by AWS.");
      Log.Error ("SSL is required for the OpenID connector to connect to OpenID providers.");
      Log.Error ("Please, rebuild AWS with SSL support.");
      return;
   end if;
   begin
      C.Load_Properties (CONFIG_PATH);
      Util.Log.Loggers.Initialize (CONFIG_PATH);

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Log.Error ("Cannot read application configuration file {0}", CONFIG_PATH);

   end;
   App.Initialize (C, Factory);
   App.Register ("samplesMsg", "samples");
   App.Set_Global ("contextPath", "/openid");

   --  Declare a global bean to identify this sample from within the XHTML files.
   App.Set_Global ("sampleName", "openid");

   App.Set_Global ("version", "0.1");
   App.Set_Global ("user", Util.Beans.Objects.To_Object (Users.User'Access,
     Util.Beans.Objects.STATIC));

   --  Register the servlets and filters
   App.Add_Servlet (Name => "faces", Server => Faces'Unchecked_Access);
   App.Add_Servlet (Name => "files", Server => Files'Unchecked_Access);
   App.Add_Servlet (Name => "auth", Server => Auth'Unchecked_Access);
   App.Add_Servlet (Name => "verify-auth", Server => Verify_Auth'Unchecked_Access);
   App.Add_Servlet (Name => "perf", Server => Perf'Unchecked_Access);

   --  Register the filters
   App.Add_Filter (Name => "perf", Filter => Perf'Unchecked_Access);
   App.Add_Filter (Name => "dump", Filter => Dump'Unchecked_Access);

   --  Define servlet mappings
   App.Add_Mapping (Name => "faces", Pattern => "*.html");
   App.Add_Mapping (Name => "files", Pattern => "*.css");
   App.Add_Mapping (Name => "files", Pattern => "*.js");
   App.Add_Mapping (Name => "files", Pattern => "*.png");
   App.Add_Mapping (Name => "files", Pattern => "*.jpg");
   App.Add_Mapping (Name => "verify-auth", Pattern => "/auth/verify");
   App.Add_Mapping (Name => "auth", Pattern => "/auth/auth/*");
   App.Add_Mapping (Name => "perf", Pattern => "/statistics.xml");

   --  Install the debug filter.
   App.Add_Filter_Mapping (Name => "perf", Pattern => "*.html");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "*.html");

   App.Add_Filter_Mapping (Name => "perf", Pattern => "*.css");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "*.css");

   App.Add_Filter_Mapping (Name => "perf", Pattern => "*.png");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "*.png");

   App.Add_Filter_Mapping (Name => "perf", Pattern => "*.jpg");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "*.jpg");

   App.Add_Filter_Mapping (Name => "perf", Pattern => "/auth/verify");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "/auth/verify");

   App.Add_Filter_Mapping (Name => "perf", Pattern => "/auth/auth/*");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "/auth/auth/*");

   WS.Register_Application (CONTEXT_PATH, App'Unchecked_Access);

   Log.Info ("Connect you browser to: http://localhost:8080/openid/auth/login.html");
   WS.Start;

   delay 600.0;

   App.Close;
exception
   when E : others =>
      Ada.Text_IO.Put_Line ("Exception in server: " &
                            Ada.Exceptions.Exception_Name (E) & ": " &
                            Ada.Exceptions.Exception_Message (E));
end Openid;

Fix compilation warnings

Fix compilation warnings


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

with Ada.Exceptions;
with Ada.Calendar;

with ADO.Statements;
with ADO.Objects;
with ADO.Sessions;
with Regtests;

with Regtests.Simple.Model;
with Regtests.Images.Model;

with Util.Assertions;
with Util.Measures;
with Util.Log;
with Util.Log.Loggers;
with Util.Test_Caller;

package body ADO.Tests is

   use Util.Log;
   use Ada.Exceptions;
   use ADO.Statements;
   use type Regtests.Simple.Model.User_Ref;
   use type Regtests.Simple.Model.Allocate_Ref;

   Log : constant Loggers.Logger := Loggers.Create ("ADO.Tests");

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

   procedure Fail (T : in Test; Message : in String);
   procedure Assert_Has_Message (T : in Test;
                                 E : in Exception_Occurrence);

   procedure Fail (T : in Test; Message : in String) is
   begin
      T.Assert (False, Message);
   end Fail;

   procedure Assert_Has_Message (T : in Test;
                                 E : in Exception_Occurrence) is
      Message : constant String := Exception_Message (E);
   begin
      Log.Info ("Exception: {0}", Message);
      T.Assert (Message'Length > 0,
                "Exception " & Exception_Name (E) & " does not have any message");
   end Assert_Has_Message;

   procedure Set_Up (T : in out Test) is
   begin
      null;
   end Set_Up;

   --  ------------------------------
   --  Check:
   --     Object_Ref.Load
   --     Object_Ref.Is_Null
   --  ------------------------------
   procedure Test_Load (T : in out Test) is

      DB  : ADO.Sessions.Session := Regtests.Get_Database;

      Object : Regtests.Simple.Model.User_Ref;
   begin
      T.Assert (Object.Is_Null, "Object_Ref.Is_Null: Empty object must be null");

      Object.Load (DB, -1);
      T.Assert (False, "Object_Ref.Load: Load must raise NOT_FOUND exception");

   exception
      when ADO.Objects.NOT_FOUND =>
         T.Assert (Object.Is_Null, "Object_Ref.Load: Must not change the object");
   end Test_Load;

   --  ------------------------------
   --  Check:
   --    Object_Ref.Load
   --    Object_Ref.Save
   --    <Model>.Set_xxx (Unbounded_String)
   --    <Model>.Create
   --  ------------------------------
   procedure Test_Create_Load (T : in out Test) is

      DB     : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;

      Object : Regtests.Simple.Model.User_Ref;
      Check  : Regtests.Simple.Model.User_Ref;
   begin
      --  Initialize and save an object
      Object.Set_Name ("A simple test name");
      Object.Save (DB);

      T.Assert (Object.Get_Id > 0, "Saving an object did not allocate an identifier");

      --  Load the object
      Check.Load (DB, Object.Get_Id);
      T.Assert (not Check.Is_Null, "Object_Ref.Load: Loading the object failed");
   end Test_Create_Load;

   --  ------------------------------
   --  Check:
   --    Various error checks on database connections
   --
   --    Master_Connection.Rollback
   --  ------------------------------
   procedure Test_Not_Open (T : in out Test) is
      DB : ADO.Sessions.Master_Session;
   begin
      begin
         DB.Rollback;
         Fail (T, "Master_Connection.Rollback should raise an exception");

      exception
         when E : ADO.Sessions.NOT_OPEN =>
            Assert_Has_Message (T, E);
      end;

      begin
         DB.Commit;
         Fail (T, "Master_Connection.Commit should raise an exception");

      exception
         when E : ADO.Sessions.NOT_OPEN =>
            Assert_Has_Message (T, E);
      end;

   end Test_Not_Open;

   --  ------------------------------
   --  Check id generation
   --  ------------------------------
   procedure Test_Allocate (T : in out Test) is
      DB     : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Key    : ADO.Objects.Object_Key (Of_Type => ADO.Objects.KEY_INTEGER,
                                       Of_Class => Regtests.Simple.Model.ALLOCATE_TABLE);
      PrevId : Identifier := NO_IDENTIFIER;
      S      : Util.Measures.Stamp;
   begin
      for I in 1 .. 200 loop
         declare
            Obj : Regtests.Simple.Model.Allocate_Ref;
         begin
            Obj.Save (DB);
            Key := Obj.Get_Key;
            if PrevId /= NO_IDENTIFIER then
               T.Assert (Objects.Get_Value (Key) = PrevId + 1, "Invalid allocated identifier: "
                         & Objects.To_String (Key) & " previous=" & Identifier'Image (PrevId));
            end if;
            PrevId := Objects.Get_Value (Key);
         end;
      end loop;
      Util.Measures.Report (S, "Allocate 200 ids");
   end Test_Allocate;

   --  ------------------------------
   --  Check:
   --    Object.Save (with creation)
   --    Object.Find
   --    Object.Save (update)
   --  ------------------------------
   procedure Test_Create_Save (T : in out Test) is
      use ADO.Objects;

      DB   : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;

      Ref  : Regtests.Simple.Model.Allocate_Ref;
      Ref2 : Regtests.Simple.Model.Allocate_Ref;
   begin
      Ref.Set_Name ("Testing the allocation");
      Ref.Save (DB);
      T.Assert (Ref.Get_Id > 0, "Object must have an id");

      Ref.Set_Name ("Testing the allocation: update");
      Ref.Save (DB);

      Ref2.Load (DB, Ref.Get_Id);

   end Test_Create_Save;

   --  ------------------------------
   --  Check:
   --    Object.Save (with creation)
   --  ------------------------------
   procedure Test_Perf_Create_Save (T : in out Test) is
      use ADO.Objects;

      DB : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;

      S  : Util.Measures.Stamp;
   begin
      DB.Begin_Transaction;
      for I in 1 .. 1_000 loop
         declare
            Ref  : Regtests.Simple.Model.Allocate_Ref;
         begin
            Ref.Set_Name ("Testing the allocation");
            Ref.Save (DB);
            T.Assert (Ref.Get_Id > 0, "Object must have an id");
         end;
      end loop;
      DB.Commit;
      Util.Measures.Report (S, "Create 1000 rows");
   end Test_Perf_Create_Save;

   procedure Test_Delete_All (T : in out Test) is

      DB : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Stmt : ADO.Statements.Delete_Statement
        := DB.Create_Statement (Regtests.Simple.Model.ALLOCATE_TABLE);
      Result : Natural;
   begin
      DB.Begin_Transaction;
      Stmt.Execute (Result);
      Log.Info ("Deleted {0} rows", Natural'Image (Result));
      DB.Commit;

      T.Assert (Result > 100, "Too few rows were deleted");
   end Test_Delete_All;

   --  ------------------------------
   --  Test string insert.
   --  ------------------------------
   procedure Test_String (T : in out Test) is
      use ADO.Objects;
      use Ada.Strings.Unbounded;

      DB   : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      User : Regtests.Simple.Model.User_Ref;
      Usr2 : Regtests.Simple.Model.User_Ref;
      Name : Unbounded_String;
   begin
      for I in 1 .. 127 loop
         Append (Name, Character'Val (I));
      end loop;
      Append (Name, ' ');
      Append (Name, ' ');
      Append (Name, ' ');
      Append (Name, ' ');
      DB.Begin_Transaction;
      User.Set_Name (Name);
      User.Save (DB);
      DB.Commit;

      --  Check that we can load the image and the blob.
      Usr2.Load (DB, User.Get_Id);
      Util.Tests.Assert_Equals (T, To_String (Name), String '(Usr2.Get_Name),
                                "Invalid name inserted for user");
   end Test_String;

   --  ------------------------------
   --  Test blob insert.
   --  ------------------------------
   procedure Test_Blob (T : in out Test) is
      use ADO.Objects;
      use Ada.Streams;

      procedure Assert_Equals is
        new Util.Assertions.Assert_Equals_T (Ada.Streams.Stream_Element);

      DB   : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Img  : Regtests.Images.Model.Image_Ref;
      Size : constant Natural := 100;
      Data : ADO.Blob_Ref := ADO.Create_Blob (Size);
      Img2 : Regtests.Images.Model.Image_Ref;
   begin
      for I in 1 .. Size loop
         Data.Value.Data (Ada.Streams.Stream_Element_Offset (I)) := Integer'Pos ((64 + I) mod 255);
      end loop;
      DB.Begin_Transaction;
      Img.Set_Image (Data);
      Img.Set_Create_Date (Ada.Calendar.Clock);
      Img.Save (DB);
      DB.Commit;

      --  Check that we can load the image and the blob.
      Img2.Load (DB, Img.Get_Id);
      T.Assert (Img2.Get_Image.Is_Null = False, "No image blob loaded");

      --  And verify that the blob data matches what we inserted.
      Util.Tests.Assert_Equals (T, Size, Integer (Img2.Get_Image.Value.Len),
                                "Invalid blob length");
      for I in 1 .. Data.Value.Len loop
         Assert_Equals (T, Data.Value.Data (I), Img2.Get_Image.Value.Data (I),
                        "Invalid blob content at " & Stream_Element_Offset'Image (I));
      end loop;

      --  Create a blob initialized with a file content.
      Data := ADO.Create_Blob ("Makefile");
      T.Assert (not Data.Is_Null, "Null blob returned by Create_Blob");
      T.Assert (Data.Value.Len > 100, "Blob length initialized from file is too small");
   end Test_Blob;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Object_Ref.Load", Test_Load'Access);
      Caller.Add_Test (Suite, "Test Object_Ref.Save", Test_Create_Load'Access);
      Caller.Add_Test (Suite, "Test Master_Connection init error", Test_Not_Open'Access);
      Caller.Add_Test (Suite, "Test Sequences.Factory", Test_Allocate'Access);
      Caller.Add_Test (Suite, "Test Object_Ref.Save/Create/Update",
                       Test_Create_Save'Access);
      Caller.Add_Test (Suite, "Test Object_Ref.Create (DB Insert)",
                       Test_Perf_Create_Save'Access);
      Caller.Add_Test (Suite, "Test Statement.Delete_Statement (delete all)",
                       Test_Delete_All'Access);
      Caller.Add_Test (Suite, "Test insert string",
                       Test_String'Access);
      Caller.Add_Test (Suite, "Test insert blob",
                       Test_Blob'Access);
   end Add_Tests;

end ADO.Tests;

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

with Ada.Exceptions;
with Ada.Calendar;

with ADO.Statements;
with ADO.Objects;
with ADO.Sessions;
with ADO.Utils;
with Regtests;

with Regtests.Simple.Model;
with Regtests.Images.Model;

with Util.Assertions;
with Util.Measures;
with Util.Log;
with Util.Log.Loggers;
with Util.Beans.Objects;
with Util.Test_Caller;

package body ADO.Tests is

   use Util.Log;
   use Ada.Exceptions;
   use ADO.Statements;
   use type Regtests.Simple.Model.User_Ref;
   use type Regtests.Simple.Model.Allocate_Ref;

   Log : constant Loggers.Logger := Loggers.Create ("ADO.Tests");

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

   procedure Fail (T : in Test; Message : in String);
   procedure Assert_Has_Message (T : in Test;
                                 E : in Exception_Occurrence);

   procedure Fail (T : in Test; Message : in String) is
   begin
      T.Assert (False, Message);
   end Fail;

   procedure Assert_Has_Message (T : in Test;
                                 E : in Exception_Occurrence) is
      Message : constant String := Exception_Message (E);
   begin
      Log.Info ("Exception: {0}", Message);
      T.Assert (Message'Length > 0,
                "Exception " & Exception_Name (E) & " does not have any message");
   end Assert_Has_Message;

   procedure Set_Up (T : in out Test) is
   begin
      null;
   end Set_Up;

   --  ------------------------------
   --  Check:
   --     Object_Ref.Load
   --     Object_Ref.Is_Null
   --  ------------------------------
   procedure Test_Load (T : in out Test) is

      DB  : ADO.Sessions.Session := Regtests.Get_Database;

      Object : Regtests.Simple.Model.User_Ref;
   begin
      T.Assert (Object.Is_Null, "Object_Ref.Is_Null: Empty object must be null");

      Object.Load (DB, -1);
      T.Assert (False, "Object_Ref.Load: Load must raise NOT_FOUND exception");

   exception
      when ADO.Objects.NOT_FOUND =>
         T.Assert (Object.Is_Null, "Object_Ref.Load: Must not change the object");
   end Test_Load;

   --  ------------------------------
   --  Check:
   --    Object_Ref.Load
   --    Object_Ref.Save
   --    <Model>.Set_xxx (Unbounded_String)
   --    <Model>.Create
   --  ------------------------------
   procedure Test_Create_Load (T : in out Test) is

      DB     : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;

      Object : Regtests.Simple.Model.User_Ref;
      Check  : Regtests.Simple.Model.User_Ref;
   begin
      --  Initialize and save an object
      Object.Set_Name ("A simple test name");
      Object.Save (DB);

      T.Assert (Object.Get_Id > 0, "Saving an object did not allocate an identifier");

      --  Load the object
      Check.Load (DB, Object.Get_Id);
      T.Assert (not Check.Is_Null, "Object_Ref.Load: Loading the object failed");
   end Test_Create_Load;

   --  ------------------------------
   --  Check:
   --    Various error checks on database connections
   --
   --    Master_Connection.Rollback
   --  ------------------------------
   procedure Test_Not_Open (T : in out Test) is
      DB : ADO.Sessions.Master_Session;
   begin
      begin
         DB.Rollback;
         Fail (T, "Master_Connection.Rollback should raise an exception");

      exception
         when E : ADO.Sessions.NOT_OPEN =>
            Assert_Has_Message (T, E);
      end;

      begin
         DB.Commit;
         Fail (T, "Master_Connection.Commit should raise an exception");

      exception
         when E : ADO.Sessions.NOT_OPEN =>
            Assert_Has_Message (T, E);
      end;

   end Test_Not_Open;

   --  ------------------------------
   --  Check id generation
   --  ------------------------------
   procedure Test_Allocate (T : in out Test) is
      DB     : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Key    : ADO.Objects.Object_Key (Of_Type => ADO.Objects.KEY_INTEGER,
                                       Of_Class => Regtests.Simple.Model.ALLOCATE_TABLE);
      PrevId : Identifier := NO_IDENTIFIER;
      S      : Util.Measures.Stamp;
   begin
      for I in 1 .. 200 loop
         declare
            Obj : Regtests.Simple.Model.Allocate_Ref;
         begin
            Obj.Save (DB);
            Key := Obj.Get_Key;
            if PrevId /= NO_IDENTIFIER then
               T.Assert (Objects.Get_Value (Key) = PrevId + 1, "Invalid allocated identifier: "
                         & Objects.To_String (Key) & " previous=" & Identifier'Image (PrevId));
            end if;
            PrevId := Objects.Get_Value (Key);
         end;
      end loop;
      Util.Measures.Report (S, "Allocate 200 ids");
   end Test_Allocate;

   --  ------------------------------
   --  Check:
   --    Object.Save (with creation)
   --    Object.Find
   --    Object.Save (update)
   --  ------------------------------
   procedure Test_Create_Save (T : in out Test) is
      use ADO.Objects;

      DB   : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;

      Ref  : Regtests.Simple.Model.Allocate_Ref;
      Ref2 : Regtests.Simple.Model.Allocate_Ref;
   begin
      Ref.Set_Name ("Testing the allocation");
      Ref.Save (DB);
      T.Assert (Ref.Get_Id > 0, "Object must have an id");

      Ref.Set_Name ("Testing the allocation: update");
      Ref.Save (DB);

      Ref2.Load (DB, Ref.Get_Id);

   end Test_Create_Save;

   --  ------------------------------
   --  Check:
   --    Object.Save (with creation)
   --  ------------------------------
   procedure Test_Perf_Create_Save (T : in out Test) is
      use ADO.Objects;

      DB : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;

      S  : Util.Measures.Stamp;
   begin
      DB.Begin_Transaction;
      for I in 1 .. 1_000 loop
         declare
            Ref  : Regtests.Simple.Model.Allocate_Ref;
         begin
            Ref.Set_Name ("Testing the allocation");
            Ref.Save (DB);
            T.Assert (Ref.Get_Id > 0, "Object must have an id");
         end;
      end loop;
      DB.Commit;
      Util.Measures.Report (S, "Create 1000 rows");
   end Test_Perf_Create_Save;

   procedure Test_Delete_All (T : in out Test) is

      DB : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Stmt : ADO.Statements.Delete_Statement
        := DB.Create_Statement (Regtests.Simple.Model.ALLOCATE_TABLE);
      Result : Natural;
   begin
      DB.Begin_Transaction;
      Stmt.Execute (Result);
      Log.Info ("Deleted {0} rows", Natural'Image (Result));
      DB.Commit;

      T.Assert (Result > 100, "Too few rows were deleted");
   end Test_Delete_All;

   --  ------------------------------
   --  Test string insert.
   --  ------------------------------
   procedure Test_String (T : in out Test) is
      use ADO.Objects;
      use Ada.Strings.Unbounded;

      DB   : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      User : Regtests.Simple.Model.User_Ref;
      Usr2 : Regtests.Simple.Model.User_Ref;
      Name : Unbounded_String;
   begin
      for I in 1 .. 127 loop
         Append (Name, Character'Val (I));
      end loop;
      Append (Name, ' ');
      Append (Name, ' ');
      Append (Name, ' ');
      Append (Name, ' ');
      DB.Begin_Transaction;
      User.Set_Name (Name);
      User.Save (DB);
      DB.Commit;

      --  Check that we can load the image and the blob.
      Usr2.Load (DB, User.Get_Id);
      Util.Tests.Assert_Equals (T, To_String (Name), String '(Usr2.Get_Name),
                                "Invalid name inserted for user");
   end Test_String;

   --  ------------------------------
   --  Test blob insert.
   --  ------------------------------
   procedure Test_Blob (T : in out Test) is
      use ADO.Objects;
      use Ada.Streams;

      procedure Assert_Equals is
        new Util.Assertions.Assert_Equals_T (Ada.Streams.Stream_Element);

      DB   : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Img  : Regtests.Images.Model.Image_Ref;
      Size : constant Natural := 100;
      Data : ADO.Blob_Ref := ADO.Create_Blob (Size);
      Img2 : Regtests.Images.Model.Image_Ref;
   begin
      for I in 1 .. Size loop
         Data.Value.Data (Ada.Streams.Stream_Element_Offset (I)) := Integer'Pos ((64 + I) mod 255);
      end loop;
      DB.Begin_Transaction;
      Img.Set_Image (Data);
      Img.Set_Create_Date (Ada.Calendar.Clock);
      Img.Save (DB);
      DB.Commit;

      --  Check that we can load the image and the blob.
      Img2.Load (DB, Img.Get_Id);
      T.Assert (Img2.Get_Image.Is_Null = False, "No image blob loaded");

      --  And verify that the blob data matches what we inserted.
      Util.Tests.Assert_Equals (T, Size, Integer (Img2.Get_Image.Value.Len),
                                "Invalid blob length");
      for I in 1 .. Data.Value.Len loop
         Assert_Equals (T, Data.Value.Data (I), Img2.Get_Image.Value.Data (I),
                        "Invalid blob content at " & Stream_Element_Offset'Image (I));
      end loop;

      --  Create a blob initialized with a file content.
      Data := ADO.Create_Blob ("Makefile");
      T.Assert (not Data.Is_Null, "Null blob returned by Create_Blob");
      T.Assert (Data.Value.Len > 100, "Blob length initialized from file is too small");
   end Test_Blob;

   --  ------------------------------
   --  Test the To_Object and To_Identifier operations.
   --  ------------------------------
   procedure Test_Identifier_To_Object (T : in out Test) is
      Val : Util.Beans.Objects.Object := ADO.Utils.To_Object (ADO.NO_IDENTIFIER);
   begin
      T.Assert (Util.Beans.Objects.Is_Null (Val),
                "To_Object must return null for ADO.NO_IDENTIFIER");
      T.Assert (ADO.Utils.To_Identifier (Val) = ADO.NO_IDENTIFIER,
                "To_Identifier must return ADO.NO_IDENTIFIER for null");
      Val := ADO.Utils.To_Object (1);
      T.Assert (not Util.Beans.Objects.Is_Null (Val),
                "To_Object must not return null for a valid Identifier");
      T.Assert (ADO.Utils.To_Identifier (Val) = 1,
                "To_Identifier must return the correct identifier");
   end Test_Identifier_To_Object;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Object_Ref.Load", Test_Load'Access);
      Caller.Add_Test (Suite, "Test Object_Ref.Save", Test_Create_Load'Access);
      Caller.Add_Test (Suite, "Test Master_Connection init error", Test_Not_Open'Access);
      Caller.Add_Test (Suite, "Test Sequences.Factory", Test_Allocate'Access);
      Caller.Add_Test (Suite, "Test Object_Ref.Save/Create/Update",
                       Test_Create_Save'Access);
      Caller.Add_Test (Suite, "Test Object_Ref.Create (DB Insert)",
                       Test_Perf_Create_Save'Access);
      Caller.Add_Test (Suite, "Test Statement.Delete_Statement (delete all)",
                       Test_Delete_All'Access);
      Caller.Add_Test (Suite, "Test insert string",
                       Test_String'Access);
      Caller.Add_Test (Suite, "Test insert blob",
                       Test_Blob'Access);
      Caller.Add_Test (Suite, "Test ADO.Utils.To_Object/To_Identifier",
                       Test_Identifier_To_Object'Access);
   end Add_Tests;

end ADO.Tests;

Add a test to check the ADO.Utils.To_Object and ADO.Utils.To_Identifier


------------------------------------------------------------------------------
--                                                                          --
--                    Copyright (C) 2017, AdaCore                           --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of the copyright holder nor the names of its     --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

--  This package provides an interface to the on-board "window watchdog"
--  provided by the STM32F4 family.

--  Important: see Figure 215 in RM0090, the STM32 reference manual,
--  illustrating the watchdog behavior and significant events.
--  Note that time is increasing to the right in the figure.
--  www.st.com/resource/en/reference_manual/DM00031020.pdf

package STM32.WWDG is  --  the Window Watchdog
   pragma Elaborate_Body;

   procedure Enable_Watchdog_Clock;

   procedure Reset_Watchdog;
   --  Resets the peripheral using the RCC

   type Prescalers is
     (Divider_1,
      Divider_2,
      Divider_4,
      Divider_8)
     with Size => 2;
   --  These prescalers are clock frequency dividers, with numeric divisor
   --  values corresponding to the digits in the names. The dividers are used
   --  to determine the watchdog counter clock frequency driving the countdown
   --  timer.
   --
   --  The frequency is computed as follows:
   --     PCLK1 / 4096 / divider-value
   --  For example, assuming PCLK1 of 45MHz and Divider_8, we'd get:
   --     45_000_000 / 4096 / 8 => 1373 Hz
   --
   --  The frequency can be used to calculate the time span values for the
   --  refresh window, for example. See the demo program for doing that.

   procedure Set_Watchdog_Prescaler (Value : Prescalers);
   --  Set the divider used to derive the watchdog counter clock frequency
   --  driving the countdown timer.
   --
   --  Note that the watchdog counter only counts down to 16#40# (64) before
   --  triggering the reset, and the upper limit for the counter value is 127,
   --  so there is a relatively limited number of counts available for the
   --  refresh window to be open. Therefore, the frequency at which the
   --  watchdog clock drives the counter is a significant factor in the
   --  total possible time span for the refresh window.

   subtype Downcounter is UInt7 range 16#40# .. UInt7'Last;
   --  16#40# is the last value of the countdown counter prior to a reset. When
   --  the count goes to 16#3F# the high-oder bit being cleared triggers the
   --  reset (if the watchdog is activated). Thus we never want to specify a
   --  counter value less than 16#40#.

   procedure Set_Watchdog_Window (Window_Start_Count : Downcounter);
   --  Set the value of the countdown counter for when the refresh window is
   --  to open. In figure 215, this is the counter value at the start of the
   --  "refresh allowed" interval. It is an arbitrary, user-defined value.
   --
   --  The last counter value prior to reset is always 64 (16#40#). At 16#3F#
   --  the high-order counter bit (T6 in the figure) clears, causing the
   --  watchdog to trigger the system reset (when activated).
   --
   --  To prevent a reset, the watchdog counter must be refreshed by the
   --  application but only when the counter is lower than Value and greater
   --  than 16#3F#.

   procedure Activate_Watchdog (New_Count : Downcounter);
   --  Set the watchdog counter to begin counting down from New_Count and
   --  activate the watchdog. In the figure, this is the counter value at
   --  the start of the "refresh not allowed" interval. It is an arbitrary,
   --  user-defined value.
   --
   --  Once activated there is no way to deactivate the watchdog other
   --  than a system reset.
   --
   --  Note that, as a "window" watchdog, the period in which the counter can
   --  be refreshed does not open immediately upon activating the watchdog.

   procedure Refresh_Watchdog_Counter (New_Count : Downcounter);
   --  Set the counter to begin counting down from New_Count. Used to refresh
   --  the watchdog counter in order to prevent the watchdog timeout. In the
   --  figure, this is the counter value at the start of the "refresh not
   --  allowed" interval. It is an arbitrary, user-defined value, but is likely
   --  the same value passed to Activate_Watchdog. The difference between this
   --  routine and the activating routine is soley the activation.

   procedure Enable_Early_Wakeup_Interrupt;
   --  When enabled, an interrupt occurs whenever the counter reaches the value
   --  16#40#, ie one counter decrement period before the counter causes a
   --  system reset. Once enabled, this interrupt can only be disabled by
   --  hardware after a system reset.

   function Early_Wakeup_Interrupt_Indicated return Boolean
     with Inline;
   --  Set by hardware when the counter has reached the value 16#40#, the
   --  counter value just prior to the reset being triggered. Always set,
   --  even if the interrupt is not enabled.

   procedure Clear_Early_Wakeup_Interrupt
     with Inline;
   --  Clears the status bit

   function WWDG_Reset_Indicated return Boolean;
   --  Indicated in the RCC peripheral

   procedure Clear_WWDG_Reset_Flag;
   --  In the RCC peripheral

   procedure Reset_System;
   --  an immediate software-driven reset, just as if the count hit 16#3F#

end STM32.WWDG;

------------------------------------------------------------------------------
--                                                                          --
--                    Copyright (C) 2017, AdaCore                           --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of the copyright holder nor the names of its     --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

--  This package provides an interface to the on-board "window watchdog"
--  provided by the STM32F4 family.

--  Important: see Figure 215 in RM0090, the STM32 reference manual,
--  illustrating the watchdog behavior and significant events.
--  Note that time is increasing to the right in the figure.
--  www.st.com/resource/en/reference_manual/DM00031020.pdf

package STM32.WWDG is  --  the Window Watchdog
   pragma Elaborate_Body;

   procedure Enable_Watchdog_Clock;

   procedure Reset_Watchdog;
   --  Resets the peripheral using the RCC

   type Prescalers is
     (Divider_1,
      Divider_2,
      Divider_4,
      Divider_8)
     with Size => 2;
   --  These prescalers are clock frequency dividers, with numeric divisor
   --  values corresponding to the digits in the names. The dividers are used
   --  to determine the watchdog counter clock frequency driving the countdown
   --  timer.
   --
   --  The frequency is computed as follows:
   --     PCLK1 / 4096 / divider-value
   --  For example, assuming PCLK1 of 45MHz and Divider_8, we'd get:
   --     45_000_000 / 4096 / 8 => 1373 Hz
   --
   --  The frequency can be used to calculate the time span values for the
   --  refresh window, for example. See the demo program for doing that.

   procedure Set_Watchdog_Prescaler (Value : Prescalers);
   --  Set the divider used to derive the watchdog counter clock frequency
   --  driving the countdown timer.
   --
   --  Note that the watchdog counter only counts down to 16#40# (64) before
   --  triggering the reset, and the upper limit for the counter value is 127,
   --  so there is a relatively limited number of counts available for the
   --  refresh window to be open. Therefore, the frequency at which the
   --  watchdog clock drives the counter is a significant factor in the
   --  total possible time span for the refresh window.

   subtype Downcounter is UInt7 range 16#40# .. UInt7'Last;
   --  16#40# is the last value of the countdown counter prior to a reset. When
   --  the count goes to 16#3F# the high-oder bit being cleared triggers the
   --  reset (if the watchdog is activated). Thus we never want to specify a
   --  counter value less than 16#40#.

   procedure Set_Watchdog_Window (Window_Start_Count : Downcounter);
   --  Set the value of the countdown counter for when the refresh window is
   --  to open. In figure 215, this is the counter value at the start of the
   --  "refresh allowed" interval. It is an arbitrary, user-defined value.
   --
   --  The last counter value prior to reset is always 64 (16#40#). At 16#3F#
   --  the high-order counter bit (T6 in the figure) clears, causing the
   --  watchdog to trigger the system reset (when activated).
   --
   --  To prevent a reset, the watchdog counter must be refreshed by the
   --  application but only when the counter is lower than Window_Start_Count
   --  and greater than 16#3F#.

   procedure Activate_Watchdog (New_Count : Downcounter);
   --  Set the watchdog counter to begin counting down from New_Count and
   --  activate the watchdog. In the figure, this is the counter value at
   --  the start of the "refresh not allowed" interval. It is an arbitrary,
   --  user-defined value.
   --
   --  Once activated there is no way to deactivate the watchdog other
   --  than a system reset.
   --
   --  Note that, as a "window" watchdog, the period in which the counter can
   --  be refreshed does not open immediately upon activating the watchdog.

   procedure Refresh_Watchdog_Counter (New_Count : Downcounter);
   --  Set the counter to begin counting down from New_Count. Used to refresh
   --  the watchdog counter in order to prevent the watchdog timeout. In the
   --  figure, this is the counter value at the start of the "refresh not
   --  allowed" interval. It is an arbitrary, user-defined value, but is likely
   --  the same value passed to Activate_Watchdog. The difference between this
   --  routine and the activating routine is soley the activation.

   procedure Enable_Early_Wakeup_Interrupt;
   --  When enabled, an interrupt occurs whenever the counter reaches the value
   --  16#40#, ie one counter decrement period before the counter causes a
   --  system reset. Once enabled, this interrupt can only be disabled by
   --  hardware after a system reset.

   function Early_Wakeup_Interrupt_Indicated return Boolean
     with Inline;
   --  Set by hardware when the counter has reached the value 16#40#, the
   --  counter value just prior to the reset being triggered. Always set,
   --  even if the interrupt is not enabled.

   procedure Clear_Early_Wakeup_Interrupt
     with Inline;
   --  Clears the status bit

   function WWDG_Reset_Indicated return Boolean;
   --  Indicated in the RCC peripheral

   procedure Clear_WWDG_Reset_Flag;
   --  In the RCC peripheral

   procedure Reset_System;
   --  an immediate software-driven reset, just as if the count hit 16#3F#

end STM32.WWDG;

fix name of formal parameter referenced in comment


-----------------------------------------------------------------------
--  awa-tags -- Tags management
--  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.
-----------------------------------------------------------------------

--  == Introduction ==
--  The <b>Tags</b> module allows to associate general purpose tags to any database entity.
--  It provides a JSF component that allows to insert easily a list of tags in a page and
--  in a form.  An application can use the bean types defined in <tt>AWA.Tags.Beans</tt>
--  to define the tags and it will use the <tt>awa:tagList</tt> component to display them.
--  A tag cloud is also provided by the <tt>awa:tagCloud</tt> component.
--
--  == Model ==
--  The database model is generic and it uses the <tt>Entity_Type</tt> provided by
--  [http://ada-ado.googlecode.com ADO] to associate a tag to entities stored in different
--  tables.  The <tt>Entity_Type</tt> identifies the database table and the stored identifier
--  in <tt>for_entity_id</tt> defines the entity in that table.
--
--  [http://ada-awa.googlecode.com/svn/wiki/awa_tags_model.png]
--
--  @include awa-tags-modules.ads
--  @include awa-tags-beans.ads
--  @include awa-tags-components.ads
--
package AWA.Tags is

   pragma Pure;

end AWA.Tags;

-----------------------------------------------------------------------
--  awa-tags -- Tags management
--  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.
-----------------------------------------------------------------------

--  == Introduction ==
--  The <b>Tags</b> module allows to associate general purpose tags to any database entity.
--  It provides a JSF component that allows to insert easily a list of tags in a page and
--  in a form.  An application can use the bean types defined in <tt>AWA.Tags.Beans</tt>
--  to define the tags and it will use the <tt>awa:tagList</tt> component to display them.
--  A tag cloud is also provided by the <tt>awa:tagCloud</tt> component.
--
--  == Model ==
--  The database model is generic and it uses the <tt>Entity_Type</tt> provided by
--  [http://ada-ado.googlecode.com ADO] to associate a tag to entities stored in different
--  tables.  The <tt>Entity_Type</tt> identifies the database table and the stored identifier
--  in <tt>for_entity_id</tt> defines the entity in that table.
--
--  [http://ada-awa.googlecode.com/svn/wiki/awa_tags_model.png]
--
--  @include awa-tags-modules.ads
--  @include awa-tags-beans.ads
--  @include awa-tags-components.ads
--
--  == Queries ==
--  @include tag-queries.xml
package AWA.Tags is

   pragma Pure;

end AWA.Tags;

Update the documentation

Update the documentation


-----------------------------------------------------------------------
--  ado-parameters-tests -- Test query parameters and SQL expansion
--  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.Tests;
package ADO.Parameters.Tests is

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

   type Test is new Util.Tests.Test with null record;

   --  Test expand SQL with parameters.
   procedure Test_Expand_Sql (T : in out Test);

   --  Test expand with invalid parameters.
   procedure Test_Expand_Error (T : in out Test);

   --  Test expand performance.
   procedure Test_Expand_Perf (T : in out Test);

end ADO.Parameters.Tests;

-----------------------------------------------------------------------
--  ado-parameters-tests -- Test query parameters and SQL expansion
--  Copyright (C) 2011, 2012, 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 Util.Tests;
package ADO.Parameters.Tests is

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

   type Test is new Util.Tests.Test with null record;

   --  Test expand SQL with parameters.
   procedure Test_Expand_Sql (T : in out Test);

   --  Test expand with invalid parameters.
   procedure Test_Expand_Error (T : in out Test);

   --  Test expand performance.
   procedure Test_Expand_Perf (T : in out Test);

   --  Test expand with cache expander.
   procedure Test_Expand_With_Expander (T : in out Test);

end ADO.Parameters.Tests;

Declare the Test_Expand_With_Expander procedure


-----------------------------------------------------------------------
--  AWA tests - AWA Tests Framework
--  Copyright (C) 2011, 2012, 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 AWA.Applications;
with AWA.Services.Filters;

with Util.Properties;
with Util.Tests;
with Util.XUnit;

with ASF.Filters.Dump;
with ASF.Servlets.Faces;
with ASF.Servlets.Files;
with ASF.Servlets.Ajax;
with ASF.Servlets.Measures;
package AWA.Tests is

   type Test is abstract new Util.Tests.Test with null record;

   --  Setup the service context before executing the test.
   overriding
   procedure Set_Up (T : in out Test);

   --  Cleanup after the test execution.
   overriding
   procedure Tear_Down (T : in out Test);

   --  Initialize the AWA test framework mockup.
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean);

   --  Called when the testsuite execution has finished.
   procedure Finish (Status : in Util.XUnit.Status);

   procedure Initialize (Props : in Util.Properties.Manager);

   --  Get the test application.
   function Get_Application return AWA.Applications.Application_Access;

   --  Set the application context to simulate a web request context.
   procedure Set_Application_Context;

   type Test_Application is new AWA.Applications.Application with record
      Self              : AWA.Applications.Application_Access;

      --  Application servlets and filters (add new servlet and filter instances here).
      Faces             : aliased ASF.Servlets.Faces.Faces_Servlet;
      Ajax              : aliased ASF.Servlets.Ajax.Ajax_Servlet;
      Files             : aliased ASF.Servlets.Files.File_Servlet;
      Dump              : aliased ASF.Filters.Dump.Dump_Filter;
      Service_Filter    : aliased AWA.Services.Filters.Service_Filter;
      Measures          : aliased ASF.Servlets.Measures.Measure_Servlet;
   end record;

   --  Initialize the servlets provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application servlets.
   overriding
   procedure Initialize_Servlets (App : in out Test_Application);

   --  Initialize the filters provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application filters.
   overriding
   procedure Initialize_Filters (App : in out Test_Application);

end AWA.Tests;

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

with AWA.Applications;
with AWA.Services.Filters;

with Util.Properties;
with Util.Tests;
with Util.XUnit;

with ASF.Filters.Dump;
with ASF.Servlets.Faces;
with Servlet.Core.Files;
with ASF.Servlets.Ajax;
with Servlet.Core.Measures;
package AWA.Tests is

   type Test is abstract new Util.Tests.Test with null record;

   --  Setup the service context before executing the test.
   overriding
   procedure Set_Up (T : in out Test);

   --  Cleanup after the test execution.
   overriding
   procedure Tear_Down (T : in out Test);

   --  Initialize the AWA test framework mockup.
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean);

   --  Called when the testsuite execution has finished.
   procedure Finish (Status : in Util.XUnit.Status);

   procedure Initialize (Props : in Util.Properties.Manager);

   --  Get the test application.
   function Get_Application return AWA.Applications.Application_Access;

   --  Set the application context to simulate a web request context.
   procedure Set_Application_Context;

   type Test_Application is new AWA.Applications.Application with record
      Self              : AWA.Applications.Application_Access;

      --  Application servlets and filters (add new servlet and filter instances here).
      Faces             : aliased ASF.Servlets.Faces.Faces_Servlet;
      Ajax              : aliased ASF.Servlets.Ajax.Ajax_Servlet;
      Files             : aliased Servlet.Core.Files.File_Servlet;
      Dump              : aliased ASF.Filters.Dump.Dump_Filter;
      Service_Filter    : aliased AWA.Services.Filters.Service_Filter;
      Measures          : aliased Servlet.Core.Measures.Measure_Servlet;
   end record;

   --  Initialize the servlets provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application servlets.
   overriding
   procedure Initialize_Servlets (App : in out Test_Application);

   --  Initialize the filters provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application filters.
   overriding
   procedure Initialize_Filters (App : in out Test_Application);

end AWA.Tests;

Use Servlet.Core packages instead of ASF.Servlets


-----------------------------------------------------------------------
--  wiki -- Ada Wiki Engine
--  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 Wiki.Attributes;
with Wiki.Strings;
with Util.Refs;
package Wiki.Nodes is

   pragma Preelaborate;

   type Node_Kind is (N_LINE_BREAK,
                      N_HORIZONTAL_RULE,
                      N_PARAGRAPH,
                      N_HEADER,
                      N_BLOCKQUOTE,
                      N_QUOTE,
                      N_TAG_START,
                      N_PREFORMAT,
                      N_LIST,
                      N_NUM_LIST,
                      N_INDENT,
                      N_TEXT,
                      N_LINK,
                      N_IMAGE);

   --  Node kinds which are simple markers in the document.
   subtype Simple_Node_Kind is Node_Kind range N_LINE_BREAK .. N_PARAGRAPH;

   type Node_List_Ref is private;

   type Node_List is limited private;
   type Node_List_Access is access all Node_List;

   type Node_Type;
   type Node_Type_Access is access all Node_Type;

   type Node_Type (Kind : Node_Kind; Len : Natural) is limited record
      case Kind is
         when N_HEADER | N_BLOCKQUOTE | N_INDENT | N_LIST | N_NUM_LIST =>
            Level  : Natural := 0;
            Header : Wiki.Strings.WString (1 .. Len);

         when N_TEXT =>
            Format : Format_Map;
            Text   : Wiki.Strings.WString (1 .. Len);

         when N_LINK | N_IMAGE | N_QUOTE =>
            Link_Attr  : Wiki.Attributes.Attribute_List;
            Title      : Wiki.Strings.WString (1 .. Len);

         when N_TAG_START =>
            Tag_Start  : Html_Tag;
            Attributes : Wiki.Attributes.Attribute_List;
            Children   : Node_List_Access;
            Parent     : Node_Type_Access;

         when N_PREFORMAT =>
            Preformatted : Wiki.Strings.WString (1 .. Len);

         when others =>
            null;

      end case;
   end record;

   --  Append a node to the document.
   procedure Append (Into : in out Node_List;
                     Node : in Node_Type_Access);

   --  Append a node to the node list.
   procedure Append (Into : in out Node_List_Ref;
                     Node : in Node_Type_Access);

   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   procedure Iterate (List    : in Node_List_Access;
                      Process : not null access procedure (Node : in Node_Type));

   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   procedure Iterate (List    : in Node_List_Ref;
                      Process : not null access procedure (Node : in Node_Type));

private

   NODE_LIST_BLOCK_SIZE : constant Positive := 20;

   type Node_Array is array (Positive range <>) of Node_Type_Access;

   type Node_List_Block;
   type Node_List_Block_Access is access all Node_List_Block;

   type Node_List_Block (Max : Positive) is limited record
      Next  : Node_List_Block_Access;
      Last  : Natural := 0;
      List  : Node_Array (1 .. Max);
   end record;

   type Node_List is limited new Util.Refs.Ref_Entity with record
      Current : Node_List_Block_Access;
      Length  : Natural := 0;
      First   : aliased Node_List_Block (NODE_LIST_BLOCK_SIZE);
   end record;

   --  Finalize the node list to release the allocated memory.
   overriding
   procedure Finalize (List : in out Node_List);

   --  Append a node to the node list.
--   procedure Append (Into : in out Node_List;
--                     Node : in Node_Type_Access);

   package Node_List_Refs is new Util.Refs.References (Node_List, Node_List_Access);

   type Node_List_Ref is new Node_List_Refs.Ref with null record;

end Wiki.Nodes;

-----------------------------------------------------------------------
--  wiki -- Ada Wiki Engine
--  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 Wiki.Attributes;
with Wiki.Strings;
with Util.Refs;
package Wiki.Nodes is

   pragma Preelaborate;

   type Node_Kind is (N_LINE_BREAK,
                      N_HORIZONTAL_RULE,
                      N_PARAGRAPH,
                      N_HEADER,
                      N_BLOCKQUOTE,
                      N_QUOTE,
                      N_TAG_START,
                      N_PREFORMAT,
                      N_LIST,
                      N_NUM_LIST,
                      N_INDENT,
                      N_TEXT,
                      N_LINK,
                      N_IMAGE);

   --  Node kinds which are simple markers in the document.
   subtype Simple_Node_Kind is Node_Kind range N_LINE_BREAK .. N_PARAGRAPH;

   type Node_List_Ref is private;

   type Node_List is limited private;
   type Node_List_Access is access all Node_List;

   type Node_Type;
   type Node_Type_Access is access all Node_Type;

   type Node_Type (Kind : Node_Kind; Len : Natural) is limited record
      case Kind is
         when N_HEADER | N_BLOCKQUOTE | N_INDENT | N_LIST | N_NUM_LIST =>
            Level  : Natural := 0;
            Header : Wiki.Strings.WString (1 .. Len);

         when N_TEXT =>
            Format : Format_Map;
            Text   : Wiki.Strings.WString (1 .. Len);

         when N_LINK | N_IMAGE | N_QUOTE =>
            Link_Attr  : Wiki.Attributes.Attribute_List;
            Title      : Wiki.Strings.WString (1 .. Len);

         when N_TAG_START =>
            Tag_Start  : Html_Tag;
            Attributes : Wiki.Attributes.Attribute_List;
            Children   : Node_List_Access;
            Parent     : Node_Type_Access;

         when N_PREFORMAT =>
            Preformatted : Wiki.Strings.WString (1 .. Len);

         when others =>
            null;

      end case;
   end record;

   --  Append a node to the tag node.
   procedure Append (Into : in Node_Type_Access;
                     Node : in Node_Type_Access);

   --  Append a node to the document.
   procedure Append (Into : in out Node_List;
                     Node : in Node_Type_Access);

   --  Append a node to the node list.
   procedure Append (Into : in out Node_List_Ref;
                     Node : in Node_Type_Access);

   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   procedure Iterate (List    : in Node_List_Access;
                      Process : not null access procedure (Node : in Node_Type));

   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   procedure Iterate (List    : in Node_List_Ref;
                      Process : not null access procedure (Node : in Node_Type));

private

   NODE_LIST_BLOCK_SIZE : constant Positive := 20;

   type Node_Array is array (Positive range <>) of Node_Type_Access;

   type Node_List_Block;
   type Node_List_Block_Access is access all Node_List_Block;

   type Node_List_Block (Max : Positive) is limited record
      Next  : Node_List_Block_Access;
      Last  : Natural := 0;
      List  : Node_Array (1 .. Max);
   end record;

   type Node_List is limited new Util.Refs.Ref_Entity with record
      Current : Node_List_Block_Access;
      Length  : Natural := 0;
      First   : aliased Node_List_Block (NODE_LIST_BLOCK_SIZE);
   end record;

   --  Finalize the node list to release the allocated memory.
   overriding
   procedure Finalize (List : in out Node_List);

   --  Append a node to the node list.
--   procedure Append (Into : in out Node_List;
--                     Node : in Node_Type_Access);

   package Node_List_Refs is new Util.Refs.References (Node_List, Node_List_Access);

   type Node_List_Ref is new Node_List_Refs.Ref with null record;

end Wiki.Nodes;

Declare the Append procedure

Declare the Append procedure