------------------------------------------------------------------------------
-- Copyright (c) 2014, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Natools.S_Expressions.Test_Tools;

package body Natools.S_Expressions.Atom_Buffers.Tests is

   ----------------------
   -- Whole Test Suite --
   ----------------------

   procedure All_Tests (Report : in out NT.Reporter'Class) is
   begin
      Test_Block_Append (Report);
      Test_Octet_Append (Report);
      Test_Preallocate (Report);
      Test_Query (Report);
      Test_Query_Null (Report);
      Test_Reset (Report);
      Test_Reverse_Append (Report);
      Test_Invert (Report);
      Test_Empty_Append (Report);
   end All_Tests;

   ----------------------
   -- Individual Tests --
   ----------------------

   procedure Test_Block_Append (Report : in out NT.Reporter'Class) is
      Name : constant String := "Append in blocks";
      Data : Atom (0 .. 255);
   begin
      for O in Octet loop
         Data (Count (O)) := O;
      end loop;

      declare
         Buffer : Atom_Buffer;
      begin
         Buffer.Append (Data (0 .. 10));
         Buffer.Append (Data (11 .. 11));
         Buffer.Append (Data (12 .. 101));
         Buffer.Append (Data (102 .. 101));
         Buffer.Append (Data (102 .. 255));

         Test_Tools.Test_Atom (Report, Name, Data, Buffer.Data);
      end;
   exception
      when Error : others => Report.Report_Exception (Name, Error);
   end Test_Block_Append;

   procedure Test_Invert (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Invert procedure");
      Source : Atom (1 .. 10);
      Inverse : Atom (1 .. 10);
   begin
      for I in Source'Range loop
         Source (I) := 10 + Octet (I);
         Inverse (11 - I) := Source (I);
      end loop;

      declare
         Buffer : Atom_Buffer;
      begin
         Buffer.Invert;
         Test_Tools.Test_Atom (Test, Null_Atom, Buffer.Data);

         Buffer.Append (Source (1 .. 1));
         Buffer.Invert;
         Test_Tools.Test_Atom (Test, Source (1 .. 1), Buffer.Data);

         Buffer.Append (Source (2 .. 7));
         Buffer.Invert;
         Test_Tools.Test_Atom (Test, Inverse (4 .. 10), Buffer.Data);

         Buffer.Invert;
         Buffer.Append (Source (8 .. 10));
         Buffer.Invert;
         Test_Tools.Test_Atom (Test, Inverse, Buffer.Data);
      end;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Test_Invert;

   procedure Test_Octet_Append (Report : in out NT.Reporter'Class) is
      Name : constant String := "Append octet by octet";
      Data : Atom (0 .. 255);
   begin
      for O in Octet loop
         Data (Count (O)) := O;
      end loop;

      declare
         Buffer : Atom_Buffer;
      begin
         for O in Octet loop
            Buffer.Append (O);
         end loop;

         Test_Tools.Test_Atom (Report, Name, Data, Buffer.Data);
      end;
   exception
      when Error : others => Report.Report_Exception (Name, Error);
   end Test_Octet_Append;

   procedure Test_Preallocate (Report : in out NT.Reporter'Class) is
      Name : constant String := "Preallocation of memory";
   begin
      declare
         Buffer : Atom_Buffer;
      begin
         Buffer.Preallocate (256);

         declare
            Old_Accessor : Atom_Refs.Accessor := Buffer.Raw_Query;
         begin
            for O in Octet loop
               Buffer.Append (O);
            end loop;

            Report.Item (Name,
              NT.To_Result (Old_Accessor.Data = Buffer.Raw_Query.Data));
         end;
      end;
   exception
      when Error : others => Report.Report_Exception (Name, Error);
   end Test_Preallocate;

   procedure Test_Query (Report : in out NT.Reporter'Class) is
      Name : constant String := "Accessors";
      Data : Atom (0 .. 255);
   begin
      for O in Octet loop
         Data (Count (O)) := O;
      end loop;

      declare
         Buffer : Atom_Buffer;
      begin
         Buffer.Append (Data);

         if Buffer.Length /= Data'Length then
            Report.Item (Name, NT.Fail);
            Report.Info ("Buffer.Length returned" & Count'Image (Buffer.Length)
              & ", expected" & Count'Image (Data'Length));
            return;
         end if;

         if Buffer.Data /= Data then
            Report.Item (Name, NT.Fail);
            Report.Info ("Data, returning an Atom");
            Test_Tools.Dump_Atom (Report, Buffer.Data, "Found");
            Test_Tools.Dump_Atom (Report, Data, "Expected");
            return;
         end if;

         if Buffer.Raw_Query.Data.all /= Data then
            Report.Item (Name, NT.Fail);
            Report.Info ("Raw_Query, returning an accessor");
            Test_Tools.Dump_Atom (Report, Buffer.Raw_Query.Data.all, "Found");
            Test_Tools.Dump_Atom (Report, Data, "Expected");
            return;
         end if;

         if Buffer.Element (25) /= Data (24) then
            Report.Item (Name, NT.Fail);
            Report.Info ("Element, returning an octet");
            return;
         end if;

         declare
            O, P : Octet;
         begin
            Buffer.Pop (O);
            Buffer.Pop (P);

            if O /= Data (Data'Last)
              or P /= Data (Data'Last - 1)
              or Buffer.Data /= Data (Data'First .. Data'Last - 2)
            then
               Report.Item (Name, NT.Fail);
               Report.Info ("Pop of an octet: "
                 & Octet'Image (P) & " " & Octet'Image (O));
               Test_Tools.Dump_Atom (Report, Buffer.Data, "Remaining");
               Test_Tools.Dump_Atom (Report, Data, "Expected");
               return;
            end if;

            Buffer.Append ((P, O));

            if Buffer.Data /= Data then
               Report.Item (Name, NT.Fail);
               Report.Info ("Append back after Pop");
               Test_Tools.Dump_Atom (Report, Buffer.Data, "Found");
               Test_Tools.Dump_Atom (Report, Data, "Expected");
               return;
            end if;
         end;

         declare
            Retrieved : Atom (10 .. 310);
            Length : Count;
         begin
            Buffer.Read (Retrieved, Length);
            if Length /= Data'Length
              or else Retrieved (10 .. Length + 9) /= Data
            then
               Report.Item (Name, NT.Fail);
               Report.Info ("Read into an existing buffer");
               Report.Info ("Length returned" & Count'Image (Length)
                 & ", expected" & Count'Image (Data'Length));
               Test_Tools.Dump_Atom
                 (Report, Retrieved (10 .. Length + 9), "Found");
               Test_Tools.Dump_Atom (Report, Data, "Expected");
               return;
            end if;
         end;

         declare
            Retrieved : Atom (20 .. 50);
            Length : Count;
         begin
            Buffer.Read (Retrieved, Length);
            if Length /= Data'Length or else Retrieved /= Data (0 .. 30) then
               Report.Item (Name, NT.Fail);
               Report.Info ("Read into a buffer too small");
               Report.Info ("Length returned" & Count'Image (Length)
                 & ", expected" & Count'Image (Data'Length));
               Test_Tools.Dump_Atom (Report, Retrieved, "Found");
               Test_Tools.Dump_Atom (Report, Data (0 .. 30), "Expected");
               return;
            end if;
         end;

         declare
            procedure Check (Found : in Atom);

            Result : Boolean := False;

            procedure Check (Found : in Atom) is
            begin
               Result := Found = Data;
            end Check;
         begin
            Buffer.Query (Check'Access);
            if not Result then
               Report.Item (Name, NT.Fail);
               Report.Info ("Query with callback");
               return;
            end if;
         end;
      end;

      Report.Item (Name, NT.Success);
   exception
      when Error : others => Report.Report_Exception (Name, Error);
   end Test_Query;

   procedure Test_Query_Null (Report : in out NT.Reporter'Class) is
      Name : constant String := "Accessor variants against a null buffer";
   begin
      declare
         Buffer : Atom_Buffer;
      begin
         if Buffer.Data /= Null_Atom then
            Report.Item (Name, NT.Fail);
            Report.Info ("Data, returning an Atom");
            Test_Tools.Dump_Atom (Report, Buffer.Data, "Found");
            return;
         end if;

         if Buffer.Raw_Query.Data.all /= Null_Atom then
            Report.Item (Name, NT.Fail);
            Report.Info ("Raw_Query, returning an accessor");
            Test_Tools.Dump_Atom (Report, Buffer.Raw_Query.Data.all, "Found");
            return;
         end if;

         declare
            Retrieved : Atom (1 .. 10);
            Length : Count;
         begin
            Buffer.Read (Retrieved, Length);
            if Length /= 0 then
               Report.Item (Name, NT.Fail);
               Report.Info ("Read into an existing buffer");
               Report.Info ("Length returned" & Count'Image (Length)
                 & ", expected 0");
               return;
            end if;
         end;

         declare
            procedure Check (Found : in Atom);

            Result : Boolean := False;

            procedure Check (Found : in Atom) is
            begin
               Result := Found = Null_Atom;
            end Check;
         begin
            Buffer.Query (Check'Access);
            if not Result then
               Report.Item (Name, NT.Fail);
               Report.Info ("Query with callback");
               return;
            end if;
         end;
      end;

      Report.Item (Name, NT.Success);
   exception
      when Error : others => Report.Report_Exception (Name, Error);
   end Test_Query_Null;

   procedure Test_Reset (Report : in out NT.Reporter'Class) is
      Name : constant String := "Reset procedures";
   begin
      declare
         Buffer : Atom_Buffer;
      begin
         for O in Octet loop
            Buffer.Append (O);
         end loop;

         declare
            Accessor : Atom_Refs.Accessor := Buffer.Raw_Query;
         begin
            Buffer.Soft_Reset;

            if Buffer.Length /= 0 then
               Report.Item (Name, NT.Fail);
               Report.Info ("Soft reset left length"
                 & Count'Image (Buffer.Length));
               return;
            end if;

            if Buffer.Raw_Query.Data /= Accessor.Data then
               Report.Item (Name, NT.Fail);
               Report.Info ("Soft reset changed storage area");
               return;
            end if;

            if Buffer.Raw_Query.Data.all'Length /= Buffer.Available then
               Report.Item (Name, NT.Fail);
               Report.Info ("Available length inconsistency, recorded"
                 & Count'Image (Buffer.Available) & ", actual"
                 & Count'Image (Buffer.Raw_Query.Data.all'Length));
               return;
            end if;

            if Buffer.Data'Length /= Buffer.Used then
               Report.Item (Name, NT.Fail);
               Report.Info ("Used length inconsistency, recorded"
                 & Count'Image (Buffer.Used) & ", actual"
                 & Count'Image (Buffer.Data'Length));
               return;
            end if;
         end;

         for O in Octet'(10) .. Octet'(50) loop
            Buffer.Append (O);
         end loop;

         Buffer.Hard_Reset;

         if Buffer.Length /= 0
           or else Buffer.Available /= 0
           or else not Buffer.Ref.Is_Empty
         then
            Report.Item (Name, NT.Fail);
            Report.Info ("Hard reset did not completely clean structure");
         end if;
      end;

      Report.Item (Name, NT.Success);
   exception
      when Error : others => Report.Report_Exception (Name, Error);
   end Test_Reset;

   procedure Test_Reverse_Append (Report : in out NT.Reporter'Class) is
      Name : constant String := "procedure Append_Reverse";
      Source_1 : Atom (1 .. 10);
      Source_2 : Atom (1 .. 1);
      Source_3 : Atom (51 .. 65);
      Source_4 : Atom (1 .. 0);
      Source_5 : Atom (101 .. 114);
      Expected : Atom (1 .. 40);
   begin
      for I in Source_1'Range loop
         Source_1 (I) := 10 + Octet (I);
         Expected (Expected'First + Source_1'Last - I) := Source_1 (I);
      end loop;

      for I in Source_2'Range loop
         Source_2 (I) := 42;
         Expected (Expected'First + Source_1'Length + Source_2'Last - I)
           := Source_2 (I);
      end loop;

      for I in Source_3'Range loop
         Source_3 (I) := Octet (I);
         Expected (Expected'First + Source_1'Length + Source_2'Length
                     + I - Source_3'First)
           := Source_3 (I);
      end loop;

      for I in Source_5'Range loop
         Source_5 (I) := Octet (I);
         Expected (Expected'First + Source_1'Length + Source_2'Length
                     + Source_3'Length + Source_5'Last - I)
           := Source_5 (I);
      end loop;

      declare
         Buffer : Atom_Buffer;
      begin
         Buffer.Append_Reverse (Source_1);
         Buffer.Append_Reverse (Source_2);
         Buffer.Append (Source_3);
         Buffer.Append_Reverse (Source_4);
         Buffer.Append_Reverse (Source_5);

         Test_Tools.Test_Atom (Report, Name, Expected, Buffer.Data);
      end;
   exception
      when Error : others => Report.Report_Exception (Name, Error);
   end Test_Reverse_Append;

   procedure Test_Empty_Append (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Empty append on empty buffer");
   begin
      declare
         Buffer : Atom_Buffer;
      begin
         Buffer.Append (Null_Atom);
         Test_Tools.Test_Atom (Test, Null_Atom, Buffer.Data);
      end;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Test_Empty_Append;

end Natools.S_Expressions.Atom_Buffers.Tests;

------------------------------------------------------------------------------
-- Copyright (c) 2014, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Natools.S_Expressions.Test_Tools;

package body Natools.S_Expressions.Atom_Buffers.Tests is

   ----------------------
   -- Whole Test Suite --
   ----------------------

   procedure All_Tests (Report : in out NT.Reporter'Class) is
   begin
      Test_Block_Append (Report);
      Test_Octet_Append (Report);
      Test_Preallocate (Report);
      Test_Query (Report);
      Test_Query_Null (Report);
      Test_Reset (Report);
      Test_Reverse_Append (Report);
      Test_Invert (Report);
      Test_Empty_Append (Report);
   end All_Tests;

   ----------------------
   -- Individual Tests --
   ----------------------

   procedure Test_Block_Append (Report : in out NT.Reporter'Class) is
      Name : constant String := "Append in blocks";
      Data : Atom (0 .. 255);
   begin
      for O in Octet loop
         Data (Count (O)) := O;
      end loop;

      declare
         Buffer : Atom_Buffer;
      begin
         Buffer.Append (Data (0 .. 10));
         Buffer.Append (Data (11 .. 11));
         Buffer.Append (Data (12 .. 101));
         Buffer.Append (Data (102 .. 101));
         Buffer.Append (Data (102 .. 255));

         Test_Tools.Test_Atom (Report, Name, Data, Buffer.Data);
      end;
   exception
      when Error : others => Report.Report_Exception (Name, Error);
   end Test_Block_Append;

   procedure Test_Invert (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Invert procedure");
      Source : Atom (1 .. 10);
      Inverse : Atom (1 .. 10);
   begin
      for I in Source'Range loop
         Source (I) := 10 + Octet (I);
         Inverse (11 - I) := Source (I);
      end loop;

      declare
         Buffer : Atom_Buffer;
      begin
         Buffer.Invert;
         Test_Tools.Test_Atom (Test, Null_Atom, Buffer.Data);

         Buffer.Append (Source (1 .. 1));
         Buffer.Invert;
         Test_Tools.Test_Atom (Test, Source (1 .. 1), Buffer.Data);

         Buffer.Append (Source (2 .. 7));
         Buffer.Invert;
         Test_Tools.Test_Atom (Test, Inverse (4 .. 10), Buffer.Data);

         Buffer.Invert;
         Buffer.Append (Source (8 .. 10));
         Buffer.Invert;
         Test_Tools.Test_Atom (Test, Inverse, Buffer.Data);
      end;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Test_Invert;

   procedure Test_Octet_Append (Report : in out NT.Reporter'Class) is
      Name : constant String := "Append octet by octet";
      Data : Atom (0 .. 255);
   begin
      for O in Octet loop
         Data (Count (O)) := O;
      end loop;

      declare
         Buffer : Atom_Buffer;
      begin
         for O in Octet loop
            Buffer.Append (O);
         end loop;

         Test_Tools.Test_Atom (Report, Name, Data, Buffer.Data);
      end;
   exception
      when Error : others => Report.Report_Exception (Name, Error);
   end Test_Octet_Append;

   procedure Test_Preallocate (Report : in out NT.Reporter'Class) is
      Name : constant String := "Preallocation of memory";
   begin
      declare
         Buffer : Atom_Buffer;
      begin
         Buffer.Preallocate (256);

         declare
            Old_Accessor : Atom_Refs.Accessor := Buffer.Raw_Query;
         begin
            for O in Octet loop
               Buffer.Append (O);
            end loop;

            Report.Item (Name,
              NT.To_Result (Old_Accessor.Data = Buffer.Raw_Query.Data));
         end;
      end;
   exception
      when Error : others => Report.Report_Exception (Name, Error);
   end Test_Preallocate;

   procedure Test_Query (Report : in out NT.Reporter'Class) is
      Name : constant String := "Accessors";
      Data : Atom (0 .. 255);
   begin
      for O in Octet loop
         Data (Count (O)) := O;
      end loop;

      declare
         Buffer : Atom_Buffer;
      begin
         Buffer.Append (Data);

         if Buffer.Length /= Data'Length then
            Report.Item (Name, NT.Fail);
            Report.Info ("Buffer.Length returned" & Count'Image (Buffer.Length)
              & ", expected" & Count'Image (Data'Length));
            return;
         end if;

         if Buffer.Data /= Data then
            Report.Item (Name, NT.Fail);
            Report.Info ("Data, returning an Atom");
            Test_Tools.Dump_Atom (Report, Buffer.Data, "Found");
            Test_Tools.Dump_Atom (Report, Data, "Expected");
            return;
         end if;

         if Buffer.Raw_Query.Data.all /= Data then
            Report.Item (Name, NT.Fail);
            Report.Info ("Raw_Query, returning an accessor");
            Test_Tools.Dump_Atom (Report, Buffer.Raw_Query.Data.all, "Found");
            Test_Tools.Dump_Atom (Report, Data, "Expected");
            return;
         end if;

         if Buffer.Element (25) /= Data (24) then
            Report.Item (Name, NT.Fail);
            Report.Info ("Element, returning an octet");
            return;
         end if;

         declare
            O, P : Octet;
         begin
            Buffer.Pop (O);
            Buffer.Pop (P);

            if O /= Data (Data'Last)
              or P /= Data (Data'Last - 1)
              or Buffer.Data /= Data (Data'First .. Data'Last - 2)
            then
               Report.Item (Name, NT.Fail);
               Report.Info ("Pop of an octet: "
                 & Octet'Image (P) & " " & Octet'Image (O));
               Test_Tools.Dump_Atom (Report, Buffer.Data, "Remaining");
               Test_Tools.Dump_Atom (Report, Data, "Expected");
               return;
            end if;

            Buffer.Append ((P, O));

            if Buffer.Data /= Data then
               Report.Item (Name, NT.Fail);
               Report.Info ("Append back after Pop");
               Test_Tools.Dump_Atom (Report, Buffer.Data, "Found");
               Test_Tools.Dump_Atom (Report, Data, "Expected");
               return;
            end if;
         end;

         declare
            Retrieved : Atom (10 .. 310);
            Length : Count;
         begin
            Buffer.Read (Retrieved, Length);
            if Length /= Data'Length
              or else Retrieved (10 .. Length + 9) /= Data
            then
               Report.Item (Name, NT.Fail);
               Report.Info ("Read into an existing buffer");
               Report.Info ("Length returned" & Count'Image (Length)
                 & ", expected" & Count'Image (Data'Length));
               Test_Tools.Dump_Atom
                 (Report, Retrieved (10 .. Length + 9), "Found");
               Test_Tools.Dump_Atom (Report, Data, "Expected");
               return;
            end if;
         end;

         declare
            Retrieved : Atom (20 .. 50);
            Length : Count;
         begin
            Buffer.Read (Retrieved, Length);
            if Length /= Data'Length or else Retrieved /= Data (0 .. 30) then
               Report.Item (Name, NT.Fail);
               Report.Info ("Read into a buffer too small");
               Report.Info ("Length returned" & Count'Image (Length)
                 & ", expected" & Count'Image (Data'Length));
               Test_Tools.Dump_Atom (Report, Retrieved, "Found");
               Test_Tools.Dump_Atom (Report, Data (0 .. 30), "Expected");
               return;
            end if;
         end;

         declare
            procedure Check (Found : in Atom);

            Result : Boolean := False;

            procedure Check (Found : in Atom) is
            begin
               Result := Found = Data;
            end Check;
         begin
            Buffer.Query (Check'Access);
            if not Result then
               Report.Item (Name, NT.Fail);
               Report.Info ("Query with callback");
               return;
            end if;
         end;
      end;

      Report.Item (Name, NT.Success);
   exception
      when Error : others => Report.Report_Exception (Name, Error);
   end Test_Query;

   procedure Test_Query_Null (Report : in out NT.Reporter'Class) is
      Name : constant String := "Accessor variants against a null buffer";
   begin
      declare
         Buffer : Atom_Buffer;
      begin
         if Buffer.Data /= Null_Atom then
            Report.Item (Name, NT.Fail);
            Report.Info ("Data, returning an Atom");
            Test_Tools.Dump_Atom (Report, Buffer.Data, "Found");
            return;
         end if;

         if Buffer.Raw_Query.Data.all /= Null_Atom then
            Report.Item (Name, NT.Fail);
            Report.Info ("Raw_Query, returning an accessor");
            Test_Tools.Dump_Atom (Report, Buffer.Raw_Query.Data.all, "Found");
            return;
         end if;

         declare
            Retrieved : Atom (1 .. 10);
            Length : Count;
         begin
            Buffer.Read (Retrieved, Length);
            if Length /= 0 then
               Report.Item (Name, NT.Fail);
               Report.Info ("Read into an existing buffer");
               Report.Info ("Length returned" & Count'Image (Length)
                 & ", expected 0");
               return;
            end if;
         end;

         declare
            procedure Check (Found : in Atom);

            Result : Boolean := False;

            procedure Check (Found : in Atom) is
            begin
               Result := Found = Null_Atom;
            end Check;
         begin
            Buffer.Query (Check'Access);
            if not Result then
               Report.Item (Name, NT.Fail);
               Report.Info ("Query with callback");
               return;
            end if;
         end;
      end;

      Report.Item (Name, NT.Success);
   exception
      when Error : others => Report.Report_Exception (Name, Error);
   end Test_Query_Null;

   procedure Test_Reset (Report : in out NT.Reporter'Class) is
      Name : constant String := "Reset procedures";
   begin
      declare
         Buffer : Atom_Buffer;
      begin
         for O in Octet loop
            Buffer.Append (O);
         end loop;

         declare
            Accessor : Atom_Refs.Accessor := Buffer.Raw_Query;
         begin
            Buffer.Soft_Reset;

            if Buffer.Length /= 0 then
               Report.Item (Name, NT.Fail);
               Report.Info ("Soft reset left length"
                 & Count'Image (Buffer.Length));
               return;
            end if;

            if Buffer.Raw_Query.Data /= Accessor.Data then
               Report.Item (Name, NT.Fail);
               Report.Info ("Soft reset changed storage area");
               return;
            end if;

            if Buffer.Raw_Query.Data.all'Length /= Buffer.Capacity then
               Report.Item (Name, NT.Fail);
               Report.Info ("Available length inconsistency, recorded"
                 & Count'Image (Buffer.Capacity) & ", actual"
                 & Count'Image (Buffer.Raw_Query.Data.all'Length));
               return;
            end if;

            if Buffer.Data'Length /= Buffer.Used then
               Report.Item (Name, NT.Fail);
               Report.Info ("Used length inconsistency, recorded"
                 & Count'Image (Buffer.Used) & ", actual"
                 & Count'Image (Buffer.Data'Length));
               return;
            end if;
         end;

         for O in Octet'(10) .. Octet'(50) loop
            Buffer.Append (O);
         end loop;

         Buffer.Hard_Reset;

         if Buffer.Length /= 0
           or else Buffer.Capacity /= 0
           or else not Buffer.Ref.Is_Empty
         then
            Report.Item (Name, NT.Fail);
            Report.Info ("Hard reset did not completely clean structure");
         end if;
      end;

      Report.Item (Name, NT.Success);
   exception
      when Error : others => Report.Report_Exception (Name, Error);
   end Test_Reset;

   procedure Test_Reverse_Append (Report : in out NT.Reporter'Class) is
      Name : constant String := "procedure Append_Reverse";
      Source_1 : Atom (1 .. 10);
      Source_2 : Atom (1 .. 1);
      Source_3 : Atom (51 .. 65);
      Source_4 : Atom (1 .. 0);
      Source_5 : Atom (101 .. 114);
      Expected : Atom (1 .. 40);
   begin
      for I in Source_1'Range loop
         Source_1 (I) := 10 + Octet (I);
         Expected (Expected'First + Source_1'Last - I) := Source_1 (I);
      end loop;

      for I in Source_2'Range loop
         Source_2 (I) := 42;
         Expected (Expected'First + Source_1'Length + Source_2'Last - I)
           := Source_2 (I);
      end loop;

      for I in Source_3'Range loop
         Source_3 (I) := Octet (I);
         Expected (Expected'First + Source_1'Length + Source_2'Length
                     + I - Source_3'First)
           := Source_3 (I);
      end loop;

      for I in Source_5'Range loop
         Source_5 (I) := Octet (I);
         Expected (Expected'First + Source_1'Length + Source_2'Length
                     + Source_3'Length + Source_5'Last - I)
           := Source_5 (I);
      end loop;

      declare
         Buffer : Atom_Buffer;
      begin
         Buffer.Append_Reverse (Source_1);
         Buffer.Append_Reverse (Source_2);
         Buffer.Append (Source_3);
         Buffer.Append_Reverse (Source_4);
         Buffer.Append_Reverse (Source_5);

         Test_Tools.Test_Atom (Report, Name, Expected, Buffer.Data);
      end;
   exception
      when Error : others => Report.Report_Exception (Name, Error);
   end Test_Reverse_Append;

   procedure Test_Empty_Append (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Empty append on empty buffer");
   begin
      declare
         Buffer : Atom_Buffer;
      begin
         Buffer.Append (Null_Atom);
         Test_Tools.Test_Atom (Test, Null_Atom, Buffer.Data);
      end;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Test_Empty_Append;

end Natools.S_Expressions.Atom_Buffers.Tests;

use the new capacity accessor in tests

s_expressions-atom_buffers-tests: use the new capacity accessor in tests


-----------------------------------------------------------------------
--  gen-artifacts-xmi -- UML-XMI artifact for Code Generator
--  Copyright (C) 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 DOM.Core;
with Gen.Model.Packages;
with Gen.Model.XMI;

--  The Gen.Artifacts.XMI package is an artifact for the generation of Ada code
--  from an UML XMI description.
package Gen.Artifacts.XMI is

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

   --  After the configuration file is read, processes the node whose root
   --  is passed in Node and initializes the Model with the information.
   overriding
   procedure Initialize (Handler : in out Artifact;
                         Path    : in String;
                         Node    : in DOM.Core.Node;
                         Model   : in out Gen.Model.Packages.Model_Definition'Class;
                         Context : in out Generator'Class);

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

   --  Read the UML/XMI model file.
   procedure Read_Model (Handler : in out Artifact;
                         File    : in String;
                         Context : in out Generator'Class);

   --  Read the UML configuration files that define the pre-defined types, stereotypes
   --  and other components used by a model.  These files are XMI files as well.
   --  All the XMI files in the UML config directory are read.
   procedure Read_UML_Configuration (Handler : in out Artifact;
                                     Context : in out Generator'Class);

private

   type Artifact is new Gen.Artifacts.Artifact with record
      Nodes      : aliased Gen.Model.XMI.UML_Model;
      Has_Config : Boolean := False;

      --  Stereotype which triggers the generation of database table.
      Table_Stereotype      : Gen.Model.XMI.Stereotype_Element_Access;
      PK_Stereotype         : Gen.Model.XMI.Stereotype_Element_Access;
      FK_Stereotype         : Gen.Model.XMI.Stereotype_Element_Access;
      Data_Model_Stereotype : Gen.Model.XMI.Stereotype_Element_Access;
      Nullable_Stereotype   : Gen.Model.XMI.Stereotype_Element_Access;
      Not_Null_Stereotype   : Gen.Model.XMI.Stereotype_Element_Access;
      Use_FK_Stereotype     : Gen.Model.XMI.Stereotype_Element_Access;
      Version_Stereotype    : Gen.Model.XMI.Stereotype_Element_Access;

      --  Tag definitions which control the generation.
      Has_List_Tag          : Gen.Model.XMI.Tag_Definition_Element_Access;
      Table_Name_Tag        : Gen.Model.XMI.Tag_Definition_Element_Access;
      Sql_Type_Tag          : Gen.Model.XMI.Tag_Definition_Element_Access;

      --  Stereotype which triggers the generation of AWA bean types.
      Bean_Stereotype  : Gen.Model.XMI.Stereotype_Element_Access;
   end record;

end Gen.Artifacts.XMI;

-----------------------------------------------------------------------
--  gen-artifacts-xmi -- UML-XMI artifact for Code Generator
--  Copyright (C) 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 DOM.Core;
with Gen.Model.Packages;
with Gen.Model.XMI;

--  The Gen.Artifacts.XMI package is an artifact for the generation of Ada code
--  from an UML XMI description.
package Gen.Artifacts.XMI is

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

   --  After the configuration file is read, processes the node whose root
   --  is passed in Node and initializes the Model with the information.
   overriding
   procedure Initialize (Handler : in out Artifact;
                         Path    : in String;
                         Node    : in DOM.Core.Node;
                         Model   : in out Gen.Model.Packages.Model_Definition'Class;
                         Context : in out Generator'Class);

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

   --  Read the UML/XMI model file.
   procedure Read_Model (Handler : in out Artifact;
                         File    : in String;
                         Context : in out Generator'Class);

   --  Read the UML configuration files that define the pre-defined types, stereotypes
   --  and other components used by a model.  These files are XMI files as well.
   --  All the XMI files in the UML config directory are read.
   procedure Read_UML_Configuration (Handler : in out Artifact;
                                     Context : in out Generator'Class);

private

   type Artifact is new Gen.Artifacts.Artifact with record
      Nodes      : aliased Gen.Model.XMI.UML_Model;
      Has_Config : Boolean := False;

      --  Stereotype which triggers the generation of database table.
      Table_Stereotype      : Gen.Model.XMI.Stereotype_Element_Access;
      PK_Stereotype         : Gen.Model.XMI.Stereotype_Element_Access;
      FK_Stereotype         : Gen.Model.XMI.Stereotype_Element_Access;
      Data_Model_Stereotype : Gen.Model.XMI.Stereotype_Element_Access;
      Nullable_Stereotype   : Gen.Model.XMI.Stereotype_Element_Access;
      Not_Null_Stereotype   : Gen.Model.XMI.Stereotype_Element_Access;
      Use_FK_Stereotype     : Gen.Model.XMI.Stereotype_Element_Access;
      Version_Stereotype    : Gen.Model.XMI.Stereotype_Element_Access;

      --  Tag definitions which control the generation.
      Has_List_Tag          : Gen.Model.XMI.Tag_Definition_Element_Access;
      Table_Name_Tag        : Gen.Model.XMI.Tag_Definition_Element_Access;
      Sql_Type_Tag          : Gen.Model.XMI.Tag_Definition_Element_Access;
      Generator_Tag         : Gen.Model.XMI.Tag_Definition_Element_Access;

      --  Stereotype which triggers the generation of AWA bean types.
      Bean_Stereotype  : Gen.Model.XMI.Stereotype_Element_Access;
   end record;

end Gen.Artifacts.XMI;

Add the ADO.Table@dynamo.table.generator tagged value definition


-----------------------------------------------------------------------
--  awa-wikis-tests -- Unit tests for wikis module
--  Copyright (C) 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 Util.Test_Caller;
with Util.Strings;

with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Tests;
with AWA.Tests.Helpers.Users;

package body AWA.Wikis.Tests is

   use Ada.Strings.Unbounded;
   use AWA.Tests;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Wikis.Beans.Load_List (Anonymous)",
                       Test_Anonymous_Access'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Beans.Save",
                       Test_Create_Wiki'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Beans.Load (missing)",
                       Test_Missing_Page'Access);
   end Add_Tests;

   --  ------------------------------
   --  Get some access on the wiki as anonymous users.
   --  ------------------------------
   procedure Verify_Anonymous (T     : in out Test;
                               Page  : in String;
                               Title : in String) is
      Wiki      : constant String := To_String (T.Wiki_Ident);
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/recent",
                        "wiki-list-recent.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list recent page is invalid");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/tags/" & Wiki,
                        "wiki-list-tagged.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki tag page is invalid");

      if Page'Length > 0 then
         ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Wiki & "/" & Page,
                           "wiki-page-" & Page & ".html");
         ASF.Tests.Assert_Contains (T, "The wiki page content", Reply,
                                    "Wiki page " & Page & " is invalid");
      end if;
   end Verify_Anonymous;

   --  ------------------------------
   --  Verify that the wiki lists contain the given page.
   --  ------------------------------
   procedure Verify_List_Contains (T    : in out Test;
                                   Page : in String) is
      Wiki      : constant String := To_String (T.Wiki_Ident);
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/recent",
                        "wiki-list-recent.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list recent page is invalid");
      ASF.Tests.Assert_Contains (T, "/wikis/view/" & To_String (T.Wiki_Ident)
                                 & "/" & Page, Reply,
                                 "Wiki list recent page does not reference the page");

   end Verify_List_Contains;

   --  ------------------------------
   --  Test access to the blog as anonymous user.
   --  ------------------------------
   procedure Test_Anonymous_Access (T : in out Test) is
   begin
      T.Verify_Anonymous ("", "");
   end Test_Anonymous_Access;

   --  ------------------------------
   --  Test creation of blog by simulating web requests.
   --  ------------------------------
   procedure Test_Create_Wiki (T : in out Test) is
      procedure Create_Page (Name : in String; Title : in String);

      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Uuid      : constant String := Util.Tests.Get_Uuid;

      procedure Create_Page (Name : in String; Title : in String) is
      begin
         Request.Set_Parameter ("page-wiki-id", To_String (T.Wiki_Ident));
         Request.Set_Parameter ("post", "1");
         Request.Set_Parameter ("page-title", Title);
         Request.Set_Parameter ("text", "# Main title" & ASCII.LF
                                & "* The wiki page content." & ASCII.LF
                                & "* Second item." & ASCII.LF);
         Request.Set_Parameter ("name", Name);
         Request.Set_Parameter ("comment", "Created wiki page " & Name);
         Request.Set_Parameter ("save", "1");
         Request.Set_Parameter ("page-is-public", "1");
         Request.Set_Parameter ("wiki-format", "FORMAT_MARKDOWN");
         ASF.Tests.Do_Post (Request, Reply, "/wikis/create.html", "create-wiki.html");

         T.Page_Ident := Helpers.Extract_Redirect (Reply, "/asfunit/wikis/view/"
                                                   & To_String (T.Wiki_Ident) & "/");

         Util.Tests.Assert_Equals (T, Name, To_String (T.Page_Ident),
                                   "Invalid redirect after wiki page creation");

         --  Remove the 'wikiPage' bean from the request so that we get a new instance
         --  for the next call.
         Request.Remove_Attribute ("wikiPage");
      end Create_Page;

   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);
      Request.Set_Parameter ("title", "The Wiki Space Title");
      Request.Set_Parameter ("post", "1");
      Request.Set_Parameter ("create", "1");
      ASF.Tests.Do_Post (Request, Reply, "/wikis/setup.html", "setup-wiki.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY,
                "Invalid response after wiki space creation");
      declare
         Ident : constant String
           := Helpers.Extract_Redirect (Reply, "/asfunit/wikis/list/");
         Pos   : constant Natural
           := Util.Strings.Index (Ident, '/');
      begin
         Util.Tests.Assert_Matches (T, "^[0-9]+/recent/grid$", Ident,
                                    "Invalid wiki space identifier in the response");
         T.Wiki_Ident := To_Unbounded_String (Ident (Ident'First .. Pos - 1));
      end;
      Create_Page ("WikiPageTestName", "Wiki page title1");
      T.Verify_List_Contains (To_String (T.Page_Ident));

      Create_Page ("WikiSecondPageName", "Wiki page title2");
      T.Verify_List_Contains (To_String (T.Page_Ident));

      Create_Page ("WikiThirdPageName", "Wiki page title3");

      T.Verify_Anonymous ("WikiPageTestName", "Wiki page title1");
      T.Verify_Anonymous ("WikiSecondPageName", "Wiki page title2");
      T.Verify_Anonymous ("WikiThirdPageName", "Wiki page title3");

   end Test_Create_Wiki;

   --  ------------------------------
   --  Test getting a wiki page which does not exist.
   --  ------------------------------
   procedure Test_Missing_Page (T : in out Test) is
      Wiki      : constant String := To_String (T.Wiki_Ident);
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Wiki & "/MissingPage",
                        "wiki-page-missing.html");
      ASF.Tests.Assert_Matches (T, ".title.Wiki page does not exist./title.", Reply,
                                "Wiki page 'MissingPage' is invalid",
                                ASF.Responses.SC_NOT_FOUND);
      ASF.Tests.Assert_Matches (T, ".h2.MissingPage./h2.", Reply,
                                "Wiki page 'MissingPage' header is invalid",
                                ASF.Responses.SC_NOT_FOUND);
   end Test_Missing_Page;

end AWA.Wikis.Tests;

-----------------------------------------------------------------------
--  awa-wikis-tests -- Unit tests for wikis module
--  Copyright (C) 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 Util.Test_Caller;
with Util.Strings;

with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Tests;
with AWA.Tests.Helpers.Users;

package body AWA.Wikis.Tests is

   use Ada.Strings.Unbounded;
   use AWA.Tests;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Wikis.Beans.Load_List (Anonymous)",
                       Test_Anonymous_Access'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Beans.Save",
                       Test_Create_Wiki'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Beans.Load (missing)",
                       Test_Missing_Page'Access);
   end Add_Tests;

   --  ------------------------------
   --  Get some access on the wiki as anonymous users.
   --  ------------------------------
   procedure Verify_Anonymous (T     : in out Test;
                               Page  : in String;
                               Title : in String) is
      Wiki      : constant String := To_String (T.Wiki_Ident);
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/recent",
                        "wiki-list-recent.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list recent page is invalid");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/tags/" & Wiki,
                        "wiki-list-tagged.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki tag page is invalid");

      if Page'Length > 0 then
         ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Wiki & "/" & Page,
                           "wiki-page-" & Page & ".html");
         ASF.Tests.Assert_Contains (T, "The wiki page content", Reply,
                                    "Wiki page " & Page & " is invalid");
         declare
            Stream  : Servlet.Streams.Print_Stream := Reply.Get_Output_Stream;
            Content : Ada.Strings.Unbounded.Unbounded_String;
         begin
            Reply.Read_Content (Content);
            Stream.Write (Content);
            declare
               Link : constant String := AWA.Tests.Helpers.Extract_Link (To_String (Content), "Info");
            begin
            end;
         end;
      end if;
   end Verify_Anonymous;

   --  ------------------------------
   --  Verify that the wiki lists contain the given page.
   --  ------------------------------
   procedure Verify_List_Contains (T    : in out Test;
                                   Page : in String) is
      Wiki      : constant String := To_String (T.Wiki_Ident);
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/recent",
                        "wiki-list-recent.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list recent page is invalid");
      ASF.Tests.Assert_Contains (T, "/wikis/view/" & To_String (T.Wiki_Ident)
                                 & "/" & Page, Reply,
                                 "Wiki list recent page does not reference the page");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/popular",
                        "wiki-list-popular.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list popular page is invalid");
      ASF.Tests.Assert_Contains (T, "/wikis/view/" & To_String (T.Wiki_Ident)
                                 & "/" & Page, Reply,
                                 "Wiki list popular page does not reference the page");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/name",
                        "wiki-list-name.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list name page is invalid");
      ASF.Tests.Assert_Contains (T, "/wikis/view/" & To_String (T.Wiki_Ident)
                                 & "/" & Page, Reply,
                                 "Wiki list name page does not reference the page");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/name/grid",
                        "wiki-list-name-grid.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list name/grid page is invalid");
      ASF.Tests.Assert_Contains (T, "/wikis/view/" & To_String (T.Wiki_Ident)
                                 & "/" & Page, Reply,
                                 "Wiki list name/grid page does not reference the page");

   end Verify_List_Contains;

   --  ------------------------------
   --  Test access to the blog as anonymous user.
   --  ------------------------------
   procedure Test_Anonymous_Access (T : in out Test) is
   begin
      T.Verify_Anonymous ("", "");
   end Test_Anonymous_Access;

   --  ------------------------------
   --  Test creation of blog by simulating web requests.
   --  ------------------------------
   procedure Test_Create_Wiki (T : in out Test) is
      procedure Create_Page (Name : in String; Title : in String);

      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Uuid      : constant String := Util.Tests.Get_Uuid;

      procedure Create_Page (Name : in String; Title : in String) is
      begin
         Request.Set_Parameter ("page-wiki-id", To_String (T.Wiki_Ident));
         Request.Set_Parameter ("post", "1");
         Request.Set_Parameter ("page-title", Title);
         Request.Set_Parameter ("text", "# Main title" & ASCII.LF
                                & "* The wiki page content." & ASCII.LF
                                & "* Second item." & ASCII.LF);
         Request.Set_Parameter ("name", Name);
         Request.Set_Parameter ("comment", "Created wiki page " & Name);
         Request.Set_Parameter ("save", "1");
         Request.Set_Parameter ("page-is-public", "1");
         Request.Set_Parameter ("wiki-format", "FORMAT_MARKDOWN");
         ASF.Tests.Do_Post (Request, Reply, "/wikis/create.html", "create-wiki.html");

         T.Page_Ident := Helpers.Extract_Redirect (Reply, "/asfunit/wikis/view/"
                                                   & To_String (T.Wiki_Ident) & "/");

         Util.Tests.Assert_Equals (T, Name, To_String (T.Page_Ident),
                                   "Invalid redirect after wiki page creation");

         --  Remove the 'wikiPage' bean from the request so that we get a new instance
         --  for the next call.
         Request.Remove_Attribute ("wikiPage");
      end Create_Page;

   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);
      Request.Set_Parameter ("title", "The Wiki Space Title");
      Request.Set_Parameter ("post", "1");
      Request.Set_Parameter ("create", "1");
      ASF.Tests.Do_Post (Request, Reply, "/wikis/setup.html", "setup-wiki.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY,
                "Invalid response after wiki space creation");
      declare
         Ident : constant String
           := Helpers.Extract_Redirect (Reply, "/asfunit/wikis/list/");
         Pos   : constant Natural
           := Util.Strings.Index (Ident, '/');
      begin
         Util.Tests.Assert_Matches (T, "^[0-9]+/recent/grid$", Ident,
                                    "Invalid wiki space identifier in the response");
         T.Wiki_Ident := To_Unbounded_String (Ident (Ident'First .. Pos - 1));
      end;
      Create_Page ("WikiPageTestName", "Wiki page title1");
      T.Verify_List_Contains (To_String (T.Page_Ident));

      Create_Page ("WikiSecondPageName", "Wiki page title2");
      T.Verify_List_Contains (To_String (T.Page_Ident));

      Create_Page ("WikiThirdPageName", "Wiki page title3");

      T.Verify_Anonymous ("WikiPageTestName", "Wiki page title1");
      T.Verify_Anonymous ("WikiSecondPageName", "Wiki page title2");
      T.Verify_Anonymous ("WikiThirdPageName", "Wiki page title3");

   end Test_Create_Wiki;

   --  ------------------------------
   --  Test getting a wiki page which does not exist.
   --  ------------------------------
   procedure Test_Missing_Page (T : in out Test) is
      Wiki      : constant String := To_String (T.Wiki_Ident);
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Wiki & "/MissingPage",
                        "wiki-page-missing.html");
      ASF.Tests.Assert_Matches (T, ".title.Wiki page does not exist./title.", Reply,
                                "Wiki page 'MissingPage' is invalid",
                                ASF.Responses.SC_NOT_FOUND);
      ASF.Tests.Assert_Matches (T, ".h2.MissingPage./h2.", Reply,
                                "Wiki page 'MissingPage' header is invalid",
                                ASF.Responses.SC_NOT_FOUND);
   end Test_Missing_Page;

end AWA.Wikis.Tests;

Add more tests on the wiki page verification


-----------------------------------------------------------------------
--  awa-workspaces -- Module workspaces
--  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.
-----------------------------------------------------------------------

--  ==  Introduction ==
--  The *workspaces* plugin defines a workspace area for other plugins.
--
--  ==  Data Model ==
--  @include Workspace.hbm.xml
--
package AWA.Workspaces is
end AWA.Workspaces;

-----------------------------------------------------------------------
--  awa-workspaces -- Module workspaces
--  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.
-----------------------------------------------------------------------

--  == Introduction ==
--  The *workspaces* plugin defines a workspace area for other plugins.
--
--  == Ada Beans ==
--  @include workspaces.xml
--
--  == Data Model ==
--  @include Workspace.hbm.xml
--
package AWA.Workspaces is
end AWA.Workspaces;

Add the Ada beans in the workspace documentation


-----------------------------------------------------------------------
--  awa-jobs -- AWA Jobs
--  Copyright (C) 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.
-----------------------------------------------------------------------

--  == Introduction ==
--  The AWA.Jobs plugin defines a batch job framework for modules to perform and execute
--  long running and deferred actions.  The `Jobs` plugin is intended to help web application
--  designers in implementing end to end asynchronous operation.  A client schedules a job
--  and does not block nor wait for the immediate completion.  Instead, the client asks
--  periodically or uses other mechanisms to check for the job completion.
--
--  === Writing a job ===
--  A new job type is created by implementing the `Execute` operation of the abstract
--  `Job_Type` tagged record.
--
--    type Resize_Job is new AWA.Jobs.Job_Type with ...;
--
--  The `Execute` procedure must be implemented.  It should use the `Get_Parameter` functions
--  to retrieve the job parameters and perform the work.  While the job is being executed,
--  it can save result by using the `Set_Result` operations, save messages by using the
--  `Set_Message` operations and report the progress by using `Set_Progress`.
--  It may report the job status by using `Set_Status`.
--
--    procedure Execute (Job : in out Resize_Job) is
--    begin
--        Job.Set_Result ("done", "ok");
--    end Execute;
--
--  === Registering a job ===
--  The AWA.Jobs plugin must be able to create the job instance when it is going to
--  be executed.  For this, a registration package must be instantiated:
--
--    package Resize_Def is new AWA.Jobs.Definition (Resize_Job);
--
--  and the job definition must be added:
--
--    AWA.Jobs.Modules.Register (Resize_Def.Create'Access);
--
--  === Scheduling a job ===
--  To schedule a job, declare an instance of the job to execute and set the job specific
--  parameters.  The job parameters will be saved in the database.  As soon as parameters
--  are defined, call the `Schedule` procedure to schedule the job in the job queue and
--  obtain a job identifier.
--
--    Resize : Resize_Job;
--    ...
--    Resize.Set_Parameter ("file", "image.png");
--    Resize.Set_Parameter ("width", "32");
--    Resize.Set_Parameter ("height, "32");
--    Resize.Schedule;
--
--  === Checking for job completion ===
--
--
--  == Data Model ==
--  @include jobs.hbm.xml
--
package AWA.Jobs is

end AWA.Jobs;

-----------------------------------------------------------------------
--  awa-jobs -- AWA Jobs
--  Copyright (C) 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.
-----------------------------------------------------------------------

--  == Introduction ==
--  The AWA.Jobs plugin defines a batch job framework for modules to perform and execute
--  long running and deferred actions.  The `Jobs` plugin is intended to help web application
--  designers in implementing end to end asynchronous operation.  A client schedules a job
--  and does not block nor wait for the immediate completion.  Instead, the client asks
--  periodically or uses other mechanisms to check for the job completion.
--
--  === Writing a job ===
--  A new job type is created by implementing the `Execute` operation of the abstract
--  `Job_Type` tagged record.
--
--    type Resize_Job is new AWA.Jobs.Job_Type with ...;
--
--  The `Execute` procedure must be implemented.  It should use the `Get_Parameter` functions
--  to retrieve the job parameters and perform the work.  While the job is being executed,
--  it can save result by using the `Set_Result` operations, save messages by using the
--  `Set_Message` operations and report the progress by using `Set_Progress`.
--  It may report the job status by using `Set_Status`.
--
--    procedure Execute (Job : in out Resize_Job) is
--    begin
--        Job.Set_Result ("done", "ok");
--    end Execute;
--
--  === Registering a job ===
--  The AWA.Jobs plugin must be able to create the job instance when it is going to
--  be executed.  For this, a registration package must be instantiated:
--
--    package Resize_Def is new AWA.Jobs.Definition (Resize_Job);
--
--  and the job definition must be added:
--
--    AWA.Jobs.Modules.Register (Resize_Def.Create'Access);
--
--  === Scheduling a job ===
--  To schedule a job, declare an instance of the job to execute and set the job specific
--  parameters.  The job parameters will be saved in the database.  As soon as parameters
--  are defined, call the `Schedule` procedure to schedule the job in the job queue and
--  obtain a job identifier.
--
--    Resize : Resize_Job;
--    ...
--    Resize.Set_Parameter ("file", "image.png");
--    Resize.Set_Parameter ("width", "32");
--    Resize.Set_Parameter ("height, "32");
--    Resize.Schedule;
--
--  === Checking for job completion ===
--
--
--  @include awa-jobs-modules.ads
--
--  == Data Model ==
--  @include jobs.hbm.xml
--
package AWA.Jobs is

end AWA.Jobs;

Update the documentation

Update the documentation


-----------------------------------------------------------------------
--  gen-model-xmi -- UML-XMI model
--  Copyright (C) 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.Containers.Hashed_Maps;
with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Hash;
with Ada.Containers.Vectors;

with Util.Beans.Objects;

with Gen.Model.Tables;
package Gen.Model.XMI is

   use Ada.Strings.Unbounded;

   type Element_Type is (XMI_UNKNOWN,
                         XMI_PACKAGE,
                         XMI_CLASS,
                         XMI_ASSOCIATION,
                         XMI_ASSOCIATION_END,
                         XMI_ATTRIBUTE,
                         XMI_OPERATION,
                         XMI_ENUMERATION,
                         XMI_ENUMERATION_LITERAL,
                         XMI_TAGGED_VALUE,
                         XMI_TAG_DEFINITION,
                         XMI_DATA_TYPE,
                         XMI_STEREOTYPE,
                         XMI_COMMENT);

   type Visibility_Type is (VISIBILITY_PUBLIC,
                            VISIBILITY_PACKAGE,
                            VISIBILITY_PROTECTED,
                            VISIBILITY_PRIVATE);

   type Changeability_Type is (CHANGEABILITY_INSERT,
                               CHANGEABILITY_CHANGEABLE,
                               CHANGEABILITY_FROZEN);
   type Model_Element;
   type Tagged_Value_Element;
   type Model_Element_Access is access all Model_Element'Class;
   type Tagged_Value_Element_Access is access all Tagged_Value_Element'Class;

   --  Define a list of model elements.
   package Model_Vectors is
      new Ada.Containers.Vectors (Index_Type   => Positive,
                                  Element_Type => Model_Element_Access);

   subtype Model_Vector is Model_Vectors.Vector;

   subtype Model_Cursor is Model_Vectors.Cursor;

   --  Define a map to search an element from its XMI ID.
   package Model_Map is
     new Ada.Containers.Hashed_Maps (Key_Type        => Unbounded_String,
                                     Element_Type    => Model_Element_Access,
                                     Hash            => Ada.Strings.Unbounded.Hash,
                                     Equivalent_Keys => "=");

   subtype Model_Map_Cursor is Model_Map.Cursor;
   type Model_Map_Access is access all Model_Map.Map;

   --  Returns true if the table cursor contains a valid table
   function Has_Element (Position : in Model_Map_Cursor) return Boolean
                         renames Model_Map.Has_Element;

   --  Returns the table definition.
   function Element (Position : in Model_Map_Cursor) return Model_Element_Access
                     renames Model_Map.Element;

   --  Move the iterator to the next table definition.
   procedure Next (Position : in out Model_Map_Cursor)
                   renames Model_Map.Next;

   --  Iterate on the model element of the type <tt>On</tt> and execute the <tt>Process</tt>
   --  procedure.
   procedure Iterate (Model   : in Model_Map.Map;
                      On      : in Element_Type;
                      Process : not null access procedure (Id   : in Unbounded_String;
                                                           Node : in Model_Element_Access));

   --  Generic procedure to iterate over the XMI elements of a vector
   --  and having the entity name <b>name</b>.
   generic
      type T (<>) is limited private;
   procedure Iterate_Elements (Closure : in out T;
                               List    : in Model_Vector;
                               Process : not null access
                                 procedure (Closure : in out T;
                                            Node    : in Model_Element_Access));

   --  Map of UML models indexed on the model name.
   package UML_Model_Map is new
     Ada.Containers.Hashed_Maps (Key_Type        => Unbounded_String,
                                 Element_Type    => Model_Map.Map,
                                 Hash            => Ada.Strings.Unbounded.Hash,
                                 Equivalent_Keys => "=",
                                 "="             => Model_Map."=");
   subtype UML_Model is UML_Model_Map.Map;

   type Search_Type is (BY_NAME, BY_ID);

   --  Find the model element with the given XMI id.
   --  Returns null if the model element is not found.
   function Find (Model : in Model_Map.Map;
                  Key   : in String;
                  Mode  : in Search_Type := BY_ID) return Model_Element_Access;

   --  Find the model element within all loaded UML models.
   --  Returns null if the model element is not found.
   function Find (Model   : in UML_Model;
                  Current : in Model_Map.Map;
                  Id      : in Ada.Strings.Unbounded.Unbounded_String)
                  return Model_Element_Access;

   --  Dump the XMI model elements.
   procedure Dump (Map : in Model_Map.Map);

   --  Reconcile all the UML model elements by resolving all the references to UML elements.
   procedure Reconcile (Model : in out UML_Model);

   --  ------------------------------
   --  Model Element
   --  ------------------------------
   type Model_Element (Model : Model_Map_Access) is abstract new Definition with record
      --  Element XMI id.
      XMI_Id        : Ada.Strings.Unbounded.Unbounded_String;

      --  List of tagged values for the element.
      Tagged_Values : Model_Vector;

      --  Elements contained.
      Elements      : Model_Vector;

      --  Stereotypes associated with the element.
      Stereotypes   : Model_Vector;

      --  The parent model element;
      Parent        : Model_Element_Access;
   end record;

   --  Get the element type.
   function Get_Type (Node : in Model_Element) return Element_Type is abstract;

   --  Reconcile the element by resolving the references to other elements in the model.
   procedure Reconcile (Node  : in out Model_Element;
                        Model : in UML_Model);

   --  Find the element with the given name.  If the name is a qualified name, navigate
   --  down the package/class to find the appropriate element.
   --  Returns null if the element was not found.
   function Find (Node : in Model_Element;
                  Name : in String) return Model_Element_Access;

   --  Set the model name.
   procedure Set_Name (Node  : in out Model_Element;
                       Value : in Util.Beans.Objects.Object);

   --  Set the model XMI unique id.
   procedure Set_XMI_Id (Node  : in out Model_Element;
                         Value : in Util.Beans.Objects.Object);

   --  Find the tag value element with the given name.
   --  Returns null if there is no such tag.
   function Find_Tag_Value (Node : in Model_Element;
                            Name : in String) return Tagged_Value_Element_Access;

   --  Get the documentation and comment associated with the model element.
   --  Returns the empty string if there is no comment.
   function Get_Comment (Node : in Model_Element) return String;

   --  Get the full qualified name for the element.
   function Get_Qualified_Name (Node : in Model_Element) return String;

   --  Find from the model file identified by <tt>Name</tt>, the model element with the
   --  identifier or name represented by <tt>Key</tt>.
   --  Returns null if the model element is not found.
   generic
      type Element_Type is new Model_Element with private;
      type Element_Type_Access is access all Element_Type'Class;
   function Find_Element (Model   : in UML_Model;
                          Name    : in String;
                          Key     : in String;
                          Mode    : in Search_Type := BY_ID)
                          return Element_Type_Access;

   --  ------------------------------
   --  Data type
   --  ------------------------------
   type Ref_Type_Element is new Model_Element with record
      Href : Unbounded_String;
      Ref  : Model_Element_Access;
   end record;
   type Ref_Type_Element_Access is access all Ref_Type_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Ref_Type_Element) return Element_Type;

   --  Reconcile the element by resolving the references to other elements in the model.
   overriding
   procedure Reconcile (Node  : in out Ref_Type_Element;
                        Model : in UML_Model);

   --  ------------------------------
   --  Data type
   --  ------------------------------
   type Data_Type_Element is new Model_Element with null record;
   type Data_Type_Element_Access is access all Data_Type_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Data_Type_Element) return Element_Type;

   --  ------------------------------
   --  Enum
   --  ------------------------------
   type Enum_Element is new Model_Element with null record;
   type Enum_Element_Access is access all Enum_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Enum_Element) return Element_Type;

   procedure Add_Literal (Node : in out Enum_Element;
                          Id   : in Util.Beans.Objects.Object;
                          Name : in Util.Beans.Objects.Object);

   --  ------------------------------
   --  Literal
   --  ------------------------------
   --  The literal describes a possible value for an enum.
   type Literal_Element is new Model_Element with null record;
   type Literal_Element_Access is access all Literal_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Literal_Element) return Element_Type;

   --  ------------------------------
   --  Stereotype
   --  ------------------------------

   type Stereotype_Element is new Model_Element with null record;
   type Stereotype_Element_Access is access all Stereotype_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Stereotype_Element) return Element_Type;

   --  Returns True if the model element has the stereotype with the given name.
   function Has_Stereotype (Node       : in Model_Element'Class;
                            Stereotype : in Stereotype_Element_Access) return Boolean;

   --  ------------------------------
   --  Comment
   --  ------------------------------
   type Comment_Element is new Model_Element with record
      Text       : Ada.Strings.Unbounded.Unbounded_String;
      Ref_Id     : Ada.Strings.Unbounded.Unbounded_String;
   end record;
   type Comment_Element_Access is access all Comment_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Comment_Element) return Element_Type;

   --  ------------------------------
   --  An operation
   --  ------------------------------
   type Operation_Element is new Model_Element with record
      Visibility : Visibility_Type := VISIBILITY_PUBLIC;
   end record;
   type Operation_Element_Access is access all Operation_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Operation_Element) return Element_Type;

   --  ------------------------------
   --  An attribute
   --  ------------------------------
   type Attribute_Element is new Model_Element with record
      Ref_Id             : Ada.Strings.Unbounded.Unbounded_String;
      Visibility         : Visibility_Type := VISIBILITY_PUBLIC;
      Changeability      : Changeability_Type := CHANGEABILITY_CHANGEABLE;
      Initial_Value      : Util.Beans.Objects.Object;
      Multiplicity_Lower : Integer := 0;
      Multiplicity_Upper : Integer := 1;
   end record;
   type Attribute_Element_Access is access all Attribute_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Attribute_Element) return Element_Type;

   --  ------------------------------
   --  An association end
   --  ------------------------------
   type Association_End_Element is new Model_Element with record
      Visibility : Visibility_Type := VISIBILITY_PUBLIC;
   end record;
   type Association_End_Element_Access is access all Association_End_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Association_End_Element) return Element_Type;

   --  ------------------------------
   --  An association
   --  ------------------------------
   type Association_Element is new Model_Element with record
      Visibility : Visibility_Type := VISIBILITY_PUBLIC;
   end record;
   type Association_Element_Access is access all Association_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Association_Element) return Element_Type;

   --  ------------------------------
   --  Tag Definition
   --  ------------------------------
   TAG_DOCUMENTATION : constant String := "documentation";
   TAG_AUTHOR        : constant String := "author";

   type Tag_Definition_Element is new Model_Element with record
      Multiplicity_Lower : Natural := 0;
      Multiplicity_Upper : Natural := 0;
   end record;
   type Tag_Definition_Element_Access is access all Tag_Definition_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Tag_Definition_Element) return Element_Type;

   --  ------------------------------
   --  Tagged value
   --  ------------------------------
   type Tagged_Value_Element is new Model_Element with record
      Value      : Ada.Strings.Unbounded.Unbounded_String;
      Value_Type : Ada.Strings.Unbounded.Unbounded_String;
      Ref_Id     : Ada.Strings.Unbounded.Unbounded_String;
      Tag_Def    : Tag_Definition_Element_Access;
   end record;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Tagged_Value_Element) return Element_Type;

   --  Reconcile the element by resolving the references to other elements in the model.
   overriding
   procedure Reconcile (Node  : in out Tagged_Value_Element;
                        Model : in UML_Model);

   --  ------------------------------
   --  A class
   --  ------------------------------
   type Class_Element is new Model_Element with record
      Operations   : Model_Vector;
      Attributes   : Model_Vector;
      Associations : Model_Vector;
      Visibility   : Visibility_Type := VISIBILITY_PUBLIC;
   end record;
   type Class_Element_Access is access all Class_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Class_Element) return Element_Type;

   --  ------------------------------
   --  A package
   --  ------------------------------
   type Package_Element;
   type Package_Element_Access is access all Package_Element'Class;

   type Package_Element is new Model_Element with record
      Classes      : Model_Vector;
   end record;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Package_Element) return Element_Type;

end Gen.Model.XMI;

-----------------------------------------------------------------------
--  gen-model-xmi -- UML-XMI model
--  Copyright (C) 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.Containers.Hashed_Maps;
with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Hash;
with Ada.Containers.Vectors;

with Util.Beans.Objects;

with Gen.Model.Tables;
package Gen.Model.XMI is

   use Ada.Strings.Unbounded;

   type Element_Type is (XMI_UNKNOWN,
                         XMI_PACKAGE,
                         XMI_CLASS,
                         XMI_ASSOCIATION,
                         XMI_ASSOCIATION_END,
                         XMI_ATTRIBUTE,
                         XMI_OPERATION,
                         XMI_ENUMERATION,
                         XMI_ENUMERATION_LITERAL,
                         XMI_TAGGED_VALUE,
                         XMI_TAG_DEFINITION,
                         XMI_DATA_TYPE,
                         XMI_STEREOTYPE,
                         XMI_COMMENT);

   --  Defines the visibility of an element (a package, class, attribute, operation).
   type Visibility_Type is (VISIBILITY_PUBLIC,
                            VISIBILITY_PACKAGE,
                            VISIBILITY_PROTECTED,
                            VISIBILITY_PRIVATE);

   --  Defines whether an attribute or association changes.
   type Changeability_Type is (CHANGEABILITY_INSERT,
                               CHANGEABILITY_CHANGEABLE,
                               CHANGEABILITY_FROZEN);

   type Model_Element;
   type Tagged_Value_Element;
   type Model_Element_Access is access all Model_Element'Class;
   type Tagged_Value_Element_Access is access all Tagged_Value_Element'Class;

   --  Define a list of model elements.
   package Model_Vectors is
      new Ada.Containers.Vectors (Index_Type   => Positive,
                                  Element_Type => Model_Element_Access);

   subtype Model_Vector is Model_Vectors.Vector;

   subtype Model_Cursor is Model_Vectors.Cursor;

   --  Define a map to search an element from its XMI ID.
   package Model_Map is
     new Ada.Containers.Hashed_Maps (Key_Type        => Unbounded_String,
                                     Element_Type    => Model_Element_Access,
                                     Hash            => Ada.Strings.Unbounded.Hash,
                                     Equivalent_Keys => "=");

   subtype Model_Map_Cursor is Model_Map.Cursor;
   type Model_Map_Access is access all Model_Map.Map;

   --  Returns true if the table cursor contains a valid table
   function Has_Element (Position : in Model_Map_Cursor) return Boolean
                         renames Model_Map.Has_Element;

   --  Returns the table definition.
   function Element (Position : in Model_Map_Cursor) return Model_Element_Access
                     renames Model_Map.Element;

   --  Move the iterator to the next table definition.
   procedure Next (Position : in out Model_Map_Cursor)
                   renames Model_Map.Next;

   --  Iterate on the model element of the type <tt>On</tt> and execute the <tt>Process</tt>
   --  procedure.
   procedure Iterate (Model   : in Model_Map.Map;
                      On      : in Element_Type;
                      Process : not null access procedure (Id   : in Unbounded_String;
                                                           Node : in Model_Element_Access));

   --  Generic procedure to iterate over the XMI elements of a vector
   --  and having the entity name <b>name</b>.
   generic
      type T (<>) is limited private;
   procedure Iterate_Elements (Closure : in out T;
                               List    : in Model_Vector;
                               Process : not null access
                                 procedure (Closure : in out T;
                                            Node    : in Model_Element_Access));

   --  Map of UML models indexed on the model name.
   package UML_Model_Map is new
     Ada.Containers.Hashed_Maps (Key_Type        => Unbounded_String,
                                 Element_Type    => Model_Map.Map,
                                 Hash            => Ada.Strings.Unbounded.Hash,
                                 Equivalent_Keys => "=",
                                 "="             => Model_Map."=");
   subtype UML_Model is UML_Model_Map.Map;

   type Search_Type is (BY_NAME, BY_ID);

   --  Find the model element with the given XMI id.
   --  Returns null if the model element is not found.
   function Find (Model : in Model_Map.Map;
                  Key   : in String;
                  Mode  : in Search_Type := BY_ID) return Model_Element_Access;

   --  Find the model element within all loaded UML models.
   --  Returns null if the model element is not found.
   function Find (Model   : in UML_Model;
                  Current : in Model_Map.Map;
                  Id      : in Ada.Strings.Unbounded.Unbounded_String)
                  return Model_Element_Access;

   --  Dump the XMI model elements.
   procedure Dump (Map : in Model_Map.Map);

   --  Reconcile all the UML model elements by resolving all the references to UML elements.
   procedure Reconcile (Model : in out UML_Model);

   --  ------------------------------
   --  Model Element
   --  ------------------------------
   type Model_Element (Model : Model_Map_Access) is abstract new Definition with record
      --  Element XMI id.
      XMI_Id        : Ada.Strings.Unbounded.Unbounded_String;

      --  List of tagged values for the element.
      Tagged_Values : Model_Vector;

      --  Elements contained.
      Elements      : Model_Vector;

      --  Stereotypes associated with the element.
      Stereotypes   : Model_Vector;

      --  The parent model element;
      Parent        : Model_Element_Access;
   end record;

   --  Get the element type.
   function Get_Type (Node : in Model_Element) return Element_Type is abstract;

   --  Reconcile the element by resolving the references to other elements in the model.
   procedure Reconcile (Node  : in out Model_Element;
                        Model : in UML_Model);

   --  Find the element with the given name.  If the name is a qualified name, navigate
   --  down the package/class to find the appropriate element.
   --  Returns null if the element was not found.
   function Find (Node : in Model_Element;
                  Name : in String) return Model_Element_Access;

   --  Set the model name.
   procedure Set_Name (Node  : in out Model_Element;
                       Value : in Util.Beans.Objects.Object);

   --  Set the model XMI unique id.
   procedure Set_XMI_Id (Node  : in out Model_Element;
                         Value : in Util.Beans.Objects.Object);

   --  Find the tag value element with the given name.
   --  Returns null if there is no such tag.
   function Find_Tag_Value (Node : in Model_Element;
                            Name : in String) return Tagged_Value_Element_Access;

   --  Get the documentation and comment associated with the model element.
   --  Returns the empty string if there is no comment.
   function Get_Comment (Node : in Model_Element) return String;

   --  Get the full qualified name for the element.
   function Get_Qualified_Name (Node : in Model_Element) return String;

   --  Find from the model file identified by <tt>Name</tt>, the model element with the
   --  identifier or name represented by <tt>Key</tt>.
   --  Returns null if the model element is not found.
   generic
      type Element_Type is new Model_Element with private;
      type Element_Type_Access is access all Element_Type'Class;
   function Find_Element (Model   : in UML_Model;
                          Name    : in String;
                          Key     : in String;
                          Mode    : in Search_Type := BY_ID)
                          return Element_Type_Access;

   --  ------------------------------
   --  Data type
   --  ------------------------------
   type Ref_Type_Element is new Model_Element with record
      Href : Unbounded_String;
      Ref  : Model_Element_Access;
   end record;
   type Ref_Type_Element_Access is access all Ref_Type_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Ref_Type_Element) return Element_Type;

   --  Reconcile the element by resolving the references to other elements in the model.
   overriding
   procedure Reconcile (Node  : in out Ref_Type_Element;
                        Model : in UML_Model);

   --  ------------------------------
   --  Data type
   --  ------------------------------
   type Data_Type_Element is new Model_Element with null record;
   type Data_Type_Element_Access is access all Data_Type_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Data_Type_Element) return Element_Type;

   --  ------------------------------
   --  Enum
   --  ------------------------------
   type Enum_Element is new Model_Element with null record;
   type Enum_Element_Access is access all Enum_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Enum_Element) return Element_Type;

   procedure Add_Literal (Node : in out Enum_Element;
                          Id   : in Util.Beans.Objects.Object;
                          Name : in Util.Beans.Objects.Object);

   --  ------------------------------
   --  Literal
   --  ------------------------------
   --  The literal describes a possible value for an enum.
   type Literal_Element is new Model_Element with null record;
   type Literal_Element_Access is access all Literal_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Literal_Element) return Element_Type;

   --  ------------------------------
   --  Stereotype
   --  ------------------------------

   type Stereotype_Element is new Model_Element with null record;
   type Stereotype_Element_Access is access all Stereotype_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Stereotype_Element) return Element_Type;

   --  Returns True if the model element has the stereotype with the given name.
   function Has_Stereotype (Node       : in Model_Element'Class;
                            Stereotype : in Stereotype_Element_Access) return Boolean;

   --  ------------------------------
   --  Comment
   --  ------------------------------
   type Comment_Element is new Model_Element with record
      Text       : Ada.Strings.Unbounded.Unbounded_String;
      Ref_Id     : Ada.Strings.Unbounded.Unbounded_String;
   end record;
   type Comment_Element_Access is access all Comment_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Comment_Element) return Element_Type;

   --  ------------------------------
   --  An operation
   --  ------------------------------
   type Operation_Element is new Model_Element with record
      Visibility : Visibility_Type := VISIBILITY_PUBLIC;
   end record;
   type Operation_Element_Access is access all Operation_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Operation_Element) return Element_Type;

   --  ------------------------------
   --  An attribute
   --  ------------------------------
   type Attribute_Element is new Model_Element with record
      Ref_Id             : Ada.Strings.Unbounded.Unbounded_String;
      Visibility         : Visibility_Type := VISIBILITY_PUBLIC;
      Changeability      : Changeability_Type := CHANGEABILITY_CHANGEABLE;
      Initial_Value      : Util.Beans.Objects.Object;
      Multiplicity_Lower : Integer := 0;
      Multiplicity_Upper : Integer := 1;
   end record;
   type Attribute_Element_Access is access all Attribute_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Attribute_Element) return Element_Type;

   --  ------------------------------
   --  An association end
   --  ------------------------------
   type Association_End_Element is new Model_Element with record
      Visibility : Visibility_Type := VISIBILITY_PUBLIC;
   end record;
   type Association_End_Element_Access is access all Association_End_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Association_End_Element) return Element_Type;

   --  ------------------------------
   --  An association
   --  ------------------------------
   type Association_Element is new Model_Element with record
      Visibility : Visibility_Type := VISIBILITY_PUBLIC;
   end record;
   type Association_Element_Access is access all Association_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Association_Element) return Element_Type;

   --  ------------------------------
   --  Tag Definition
   --  ------------------------------
   TAG_DOCUMENTATION : constant String := "documentation";
   TAG_AUTHOR        : constant String := "author";

   type Tag_Definition_Element is new Model_Element with record
      Multiplicity_Lower : Natural := 0;
      Multiplicity_Upper : Natural := 0;
   end record;
   type Tag_Definition_Element_Access is access all Tag_Definition_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Tag_Definition_Element) return Element_Type;

   --  ------------------------------
   --  Tagged value
   --  ------------------------------
   type Tagged_Value_Element is new Model_Element with record
      Value      : Ada.Strings.Unbounded.Unbounded_String;
      Value_Type : Ada.Strings.Unbounded.Unbounded_String;
      Ref_Id     : Ada.Strings.Unbounded.Unbounded_String;
      Tag_Def    : Tag_Definition_Element_Access;
   end record;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Tagged_Value_Element) return Element_Type;

   --  Reconcile the element by resolving the references to other elements in the model.
   overriding
   procedure Reconcile (Node  : in out Tagged_Value_Element;
                        Model : in UML_Model);

   --  ------------------------------
   --  A class
   --  ------------------------------
   type Class_Element is new Model_Element with record
      Operations   : Model_Vector;
      Attributes   : Model_Vector;
      Associations : Model_Vector;
      Visibility   : Visibility_Type := VISIBILITY_PUBLIC;
   end record;
   type Class_Element_Access is access all Class_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Class_Element) return Element_Type;

   --  ------------------------------
   --  A package
   --  ------------------------------
   type Package_Element;
   type Package_Element_Access is access all Package_Element'Class;

   type Package_Element is new Model_Element with record
      Classes      : Model_Vector;
   end record;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Package_Element) return Element_Type;

end Gen.Model.XMI;

Add some comments.

Add some comments.


-----------------------------------------------------------------------
--  Util.Beans.Objects.Time -- Helper conversion for Ada Calendar Time
--  Copyright (C) 2010 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.Calendar;
package Util.Beans.Objects.Time is

   --  Create an object from the given value.
   function To_Object (Value : in Ada.Calendar.Time) return Object;

   --  Convert the object into a time.
   --  Raises Constraint_Error if the object cannot be converter to the target type.
   function To_Time (Value : in Object) return Ada.Calendar.Time;

   --  Force the object to be a time.
   function Cast_Time (Value : Object) return Object;

end Util.Beans.Objects.Time;

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

with Ada.Calendar;
with Util.Nullables;
package Util.Beans.Objects.Time is

   --  Create an object from the given value.
   function To_Object (Value : in Ada.Calendar.Time) return Object;

   function To_Object (Value : in Nullables.Nullable_Time) return Object;

   --  Convert the object into a time.
   --  Raises Constraint_Error if the object cannot be converter to the target type.
   function To_Time (Value : in Object) return Ada.Calendar.Time;

   function To_Time (Value : in Object) return Nullables.Nullable_Time;

   --  Force the object to be a time.
   function Cast_Time (Value : Object) return Object;

end Util.Beans.Objects.Time;

Add To_Object and To_Time with a Nullable_Time type