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

with Util.Test_Caller;

with Wiki.Utils;
with Wiki.Helpers;
package body Wiki.Parsers.Tests is

   use Wiki.Helpers;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Wiki.Parsers.Parse (bold)",
                       Test_Wiki_Bold'Access);
      Caller.Add_Test (Suite, "Test Wiki.Parsers.Parse (italic)",
                       Test_Wiki_Italic'Access);
      Caller.Add_Test (Suite, "Test Wiki.Parsers.Parse (italic, bold)",
                       Test_Wiki_Formats'Access);
      Caller.Add_Test (Suite, "Test Wiki.Parsers.Parse (headings)",
                       Test_Wiki_Section'Access);
      Caller.Add_Test (Suite, "Test Wiki.Parsers.Parse (lists)",
                       Test_Wiki_List'Access);
      Caller.Add_Test (Suite, "Test Wiki.Parsers.Parse (links)",
                       Test_Wiki_Link'Access);
      Caller.Add_Test (Suite, "Test Wiki.Parsers.Parse (quote)",
                       Test_Wiki_Quote'Access);
      Caller.Add_Test (Suite, "Test Wiki.Parsers.Parse (line break)",
                       Test_Wiki_Line_Break'Access);
      Caller.Add_Test (Suite, "Test Wiki.Parsers.Parse (image)",
                       Test_Wiki_Image'Access);
      Caller.Add_Test (Suite, "Test Wiki.Parsers.Parse (preformatted)",
                       Test_Wiki_Preformatted'Access);
      Caller.Add_Test (Suite, "Test Wiki.Text.Renderer",
                       Test_Wiki_Text_Renderer'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test bold rendering.
   --  ------------------------------
   procedure Test_Wiki_Bold (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, "
bold
",
                                Wiki.Utils.To_Html ("*bold*", SYNTAX_GOOGLE),
                                "Bold rendering invalid");
      Util.Tests.Assert_Equals (T, "
x bold y
",
                                Wiki.Utils.To_Html ("x *bold* y", SYNTAX_GOOGLE),
                                "Bold rendering invalid");
      Util.Tests.Assert_Equals (T, "
x bold y
",
                                Wiki.Utils.To_Html ("x *bold y", SYNTAX_MIX),
                                "Bold rendering invalid (MIX)");
      Util.Tests.Assert_Equals (T, "
x item y p
",
                                Wiki.Utils.To_Html ("x __item y__ p", SYNTAX_DOTCLEAR),
                                "Bold rendering invalid");
      Util.Tests.Assert_Equals (T, "
x _item y_ p
",
                                Wiki.Utils.To_Html ("x _item y_ p", SYNTAX_DOTCLEAR),
                                "No bold rendering invalid");
      Util.Tests.Assert_Equals (T, "
x bold y
",
                                Wiki.Utils.To_Html ("x '''bold''' y", SYNTAX_PHPBB),
                                "Bold rendering invalid (PHPBB)");
   end Test_Wiki_Bold;

   --  ------------------------------
   --  Test italic rendering.
   --  ------------------------------
   procedure Test_Wiki_Italic (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, "
item
",
                                Wiki.Utils.To_Html ("_item_", SYNTAX_GOOGLE),
                                "Italic rendering invalid");
      Util.Tests.Assert_Equals (T, "
x item y
",
                                Wiki.Utils.To_Html ("x _item_ y", SYNTAX_GOOGLE),
                                "Italic rendering invalid");
      Util.Tests.Assert_Equals (T, "
x item y
",
                                Wiki.Utils.To_Html ("x _item y", SYNTAX_MIX),
                                "Italic rendering invalid");
      Util.Tests.Assert_Equals (T, "
x item y p
",
                                Wiki.Utils.To_Html ("x ''item y'' p", SYNTAX_DOTCLEAR),
                                "Italic rendering invalid");
      Util.Tests.Assert_Equals (T, "
x item y p
",
                                Wiki.Utils.To_Html ("x ''item y'' p", SYNTAX_PHPBB),
                                "Italic rendering invalid");
      Util.Tests.Assert_Equals (T, "
x 'item y p
",
                                Wiki.Utils.To_Html ("x 'item y'' p", SYNTAX_PHPBB),
                                "Italic rendering invalid");
   end Test_Wiki_Italic;

   --  ------------------------------
   --  Test various format rendering.
   --  ------------------------------
   procedure Test_Wiki_Formats (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, "
itboldem
",
                                Wiki.Utils.To_Html ("_it*bold*em_", SYNTAX_GOOGLE),
                                "Italic+Bold rendering invalid");
      Util.Tests.Assert_Equals (T, "
x item y
",
                                Wiki.Utils.To_Html ("x _item_ y", SYNTAX_GOOGLE),
                                "Italic rendering invalid");
      Util.Tests.Assert_Equals (T, "
x item y
",
                                Wiki.Utils.To_Html ("x _item y", SYNTAX_GOOGLE),
                                "Italic rendering invalid");
   end Test_Wiki_Formats;

   --  ------------------------------
   --  Test heading rendering.
   --  ------------------------------
   procedure Test_Wiki_Section (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, "
item
",
                                Wiki.Utils.To_Html ("= item =", SYNTAX_GOOGLE),
                                "H1 rendering invalid");
      Util.Tests.Assert_Equals (T, "
item
",
                                Wiki.Utils.To_Html ("== item == ", SYNTAX_GOOGLE),
                                "H2 rendering invalid");
      Util.Tests.Assert_Equals (T, "
item
",
                                Wiki.Utils.To_Html ("=== item  ===  ", SYNTAX_GOOGLE),
                                "H3 rendering invalid");
      Util.Tests.Assert_Equals (T, "
item
",
                                Wiki.Utils.To_Html ("==== item ==== ", SYNTAX_GOOGLE),
                                "H4 rendering invalid");
      Util.Tests.Assert_Equals (T, "
item
",
                                Wiki.Utils.To_Html ("===== item =====", SYNTAX_GOOGLE),
                                "H5 rendering invalid");
      Util.Tests.Assert_Equals (T, "
item
",
                                Wiki.Utils.To_Html ("====== item ===", SYNTAX_GOOGLE),
                                "H6 rendering invalid");
      Util.Tests.Assert_Equals (T, "
item

item2
",
                                Wiki.Utils.To_Html ("= item =" & CR & "== item2 ==",
                                  SYNTAX_GOOGLE),
                                "H1 rendering invalid");
      Util.Tests.Assert_Equals (T, "
item

item2

item3
",
        Wiki.Utils.To_Html ("= item =" & CR & "== item2 ==" & CR & "= item3 =",
          SYNTAX_GOOGLE),
        "H1 rendering invalid");
   end Test_Wiki_Section;

   --  ------------------------------
   --  Test list rendering.
   --  ------------------------------
   procedure Test_Wiki_List (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, "

item

",
                                Wiki.Utils.To_Html ("# item", SYNTAX_GOOGLE),
                                "Ordered list rendering invalid");
      Util.Tests.Assert_Equals (T, "

item item " & ASCII.LF &
                                "

item2 item2" & ASCII.LF &
                                "

item3

",
        Wiki.Utils.To_Html ("# item item " & LF & "# item2 item2" & LF & "## item3",
         SYNTAX_GOOGLE),
        "Ordered rendering invalid");

      Util.Tests.Assert_Equals (T, "

item

",
                                Wiki.Utils.To_Html (" * item", SYNTAX_GOOGLE),
                                "Bullet list rendering invalid");

      Util.Tests.Assert_Equals (T, "

item

",
                                Wiki.Utils.To_Html ("* item", SYNTAX_DOTCLEAR),
                                "Bullet list rendering invalid");

   end Test_Wiki_List;

   --  ------------------------------
   --  Test link rendering.
   --  ------------------------------
   procedure Test_Wiki_Link (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, "
name
",
                                Wiki.Utils.To_Html ("[name]", SYNTAX_GOOGLE),
                                "Link rendering invalid");
      Util.Tests.Assert_Equals (T, "
name
",
                                Wiki.Utils.To_Html ("[name |http://www.joe.com/item|en|some]",
                                SYNTAX_DOTCLEAR),
                                "Link rendering invalid");
      Util.Tests.Assert_Equals (T, "
name
",
                                Wiki.Utils.To_Html ("[[name]]", SYNTAX_CREOLE),
                                "Link rendering invalid");
      Util.Tests.Assert_Equals (T, "
[d
",
                                Wiki.Utils.To_Html ("[d", SYNTAX_CREOLE),
                                "No link rendering invalid");
      Util.Tests.Assert_Equals (T, "
http://www.joe.com/item
",
                                Wiki.Utils.To_Html ("[http://www.joe.com/item]",
                                SYNTAX_DOTCLEAR),
                                "Link rendering invalid");
      Util.Tests.Assert_Equals (T, "
name
",
                                Wiki.Utils.To_Html ("[[name]]", SYNTAX_MEDIA_WIKI),
                                "Link rendering invalid");
   end Test_Wiki_Link;

   --  ------------------------------
   --  Test quote rendering.
   --  ------------------------------
   procedure Test_Wiki_Quote (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, "
<q>quote</q>
",
                                Wiki.Utils.To_Html ("{{quote}}", SYNTAX_DOTCLEAR),
                                "Quote rendering invalid");
      Util.Tests.Assert_Equals (T, "
<q lang=""en"">quote</q>
",
                                Wiki.Utils.To_Html ("{{quote|en}}", SYNTAX_DOTCLEAR),
                                "Quote rendering invalid");
      Util.Tests.Assert_Equals (T, "
<q cite=""http://www.sun.com"" lang=""en"">quote</q>
",
                                Wiki.Utils.To_Html ("{{quote|en|http://www.sun.com}}",
                                                 SYNTAX_DOTCLEAR),
                                "Quote rendering invalid");
      Util.Tests.Assert_Equals (T, "
{quote}}
",
                                Wiki.Utils.To_Html ("{quote}}", SYNTAX_DOTCLEAR),
                                "No quote rendering invalid");
   end Test_Wiki_Quote;

   --  ------------------------------
   --  Test line break rendering.
   --  ------------------------------
   procedure Test_Wiki_Line_Break (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, "
a
b
",
                                Wiki.Utils.To_Html ("a%%%b", SYNTAX_DOTCLEAR),
                                "Line break rendering invalid");
      Util.Tests.Assert_Equals (T, "
a
b
",
                                Wiki.Utils.To_Html ("a\\b", SYNTAX_CREOLE),
                                "Line break rendering invalid");
      Util.Tests.Assert_Equals (T, "
a%%b
",
                                Wiki.Utils.To_Html ("a%%b", SYNTAX_DOTCLEAR),
                                "No line break rendering invalid");
      Util.Tests.Assert_Equals (T, "
a%b
",
                                Wiki.Utils.To_Html ("a%b", SYNTAX_DOTCLEAR),
                                "No line break rendering invalid");
   end Test_Wiki_Line_Break;

   --  ------------------------------
   --  Test image rendering.
   --  ------------------------------
   procedure Test_Wiki_Image (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, "

",
                                Wiki.Utils.To_Html ("((/image/t.png))", SYNTAX_DOTCLEAR),
                                "Image rendering invalid");
      Util.Tests.Assert_Equals (T, "

",
                                Wiki.Utils.To_Html ("((/image/t.png|title))", SYNTAX_DOTCLEAR),
                                "Image rendering invalid");
      Util.Tests.Assert_Equals (T, "

",
                                Wiki.Utils.To_Html ("((/image/t.png|title|D|describe))",
                                                 SYNTAX_DOTCLEAR),
                                "Image rendering invalid");
   end Test_Wiki_Image;

   --  ------------------------------
   --  Test preformatted rendering.
   --  ------------------------------
   procedure Test_Wiki_Preformatted (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, "
<tt>code</tt>
",
                                Wiki.Utils.To_Html ("{{{code}}}", SYNTAX_GOOGLE),
                                "Preformat rendering invalid");
      Util.Tests.Assert_Equals (T, "
* code *" & ASCII.LF & "
",
                                Wiki.Utils.To_Html ("///" & LF & "* code *" & LF & "///",
                                                 SYNTAX_DOTCLEAR),
                                "Preformat rendering invalid");
      Util.Tests.Assert_Equals (T, "
item1 x" & ASCII.LF & "item2 x" & ASCII.LF & "item3 x"
                                & ASCII.LF & "
",
                                Wiki.Utils.To_Html (" item1 x" & LF & " item2 x" & LF & " item3 x",
                                                 SYNTAX_DOTCLEAR),
                                "Preformat rendering invalid");
      Util.Tests.Assert_Equals (T, "
item1 x" & ASCII.LF & "item2 x"
                                & ASCII.LF & "item3 x"
                                & ASCII.LF & "
",
                                Wiki.Utils.To_Html (" item1 x" & CR & LF & " item2 x"
                                  & CR & LF & " item3 x",
                                                 SYNTAX_DOTCLEAR),
                                "Preformat rendering invalid");
   end Test_Wiki_Preformatted;

   --  ------------------------------
   --  Test the text renderer.
   --  ------------------------------
   procedure Test_Wiki_Text_Renderer (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, ASCII.LF & "code",
                                Wiki.Utils.To_Text ("{{{code}}}", SYNTAX_GOOGLE),
                                "Preformat rendering invalid");
      Util.Tests.Assert_Equals (T, ASCII.LF & "bold item my_title" & ASCII.LF,
                                Wiki.Utils.To_Text ("_bold_ __item__ [my_title]", SYNTAX_GOOGLE),
                                "Preformat rendering invalid");

   end Test_Wiki_Text_Renderer;

end Wiki.Parsers.Tests;

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

with Util.Test_Caller;

with Wiki.Utils;
with Wiki.Helpers;
package body Wiki.Parsers.Tests is

   use Wiki.Helpers;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Wiki.Parsers.Parse (bold)",
                       Test_Wiki_Bold'Access);
      Caller.Add_Test (Suite, "Test Wiki.Parsers.Parse (italic)",
                       Test_Wiki_Italic'Access);
      Caller.Add_Test (Suite, "Test Wiki.Parsers.Parse (italic, bold)",
                       Test_Wiki_Formats'Access);
      Caller.Add_Test (Suite, "Test Wiki.Parsers.Parse (headings)",
                       Test_Wiki_Section'Access);
      Caller.Add_Test (Suite, "Test Wiki.Parsers.Parse (lists)",
                       Test_Wiki_List'Access);
      Caller.Add_Test (Suite, "Test Wiki.Parsers.Parse (links)",
                       Test_Wiki_Link'Access);
      Caller.Add_Test (Suite, "Test Wiki.Parsers.Parse (quote)",
                       Test_Wiki_Quote'Access);
      Caller.Add_Test (Suite, "Test Wiki.Parsers.Parse (line break)",
                       Test_Wiki_Line_Break'Access);
      Caller.Add_Test (Suite, "Test Wiki.Parsers.Parse (image)",
                       Test_Wiki_Image'Access);
      Caller.Add_Test (Suite, "Test Wiki.Parsers.Parse (preformatted)",
                       Test_Wiki_Preformatted'Access);
      Caller.Add_Test (Suite, "Test Wiki.Text.Renderer",
                       Test_Wiki_Text_Renderer'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test bold rendering.
   --  ------------------------------
   procedure Test_Wiki_Bold (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, "
bold
",
                                Wiki.Utils.To_Html ("*bold*", SYNTAX_GOOGLE),
                                "Bold rendering invalid");
      Util.Tests.Assert_Equals (T, "
x bold y
",
                                Wiki.Utils.To_Html ("x *bold* y", SYNTAX_GOOGLE),
                                "Bold rendering invalid");
      Util.Tests.Assert_Equals (T, "
x bold y
",
                                Wiki.Utils.To_Html ("x *bold y", SYNTAX_MIX),
                                "Bold rendering invalid (MIX)");
      Util.Tests.Assert_Equals (T, "
x item y p
",
                                Wiki.Utils.To_Html ("x __item y__ p", SYNTAX_DOTCLEAR),
                                "Bold rendering invalid");
      Util.Tests.Assert_Equals (T, "
x _item y_ p
",
                                Wiki.Utils.To_Html ("x _item y_ p", SYNTAX_DOTCLEAR),
                                "No bold rendering invalid");
      Util.Tests.Assert_Equals (T, "
x bold y
",
                                Wiki.Utils.To_Html ("x '''bold''' y", SYNTAX_PHPBB),
                                "Bold rendering invalid (PHPBB)");
   end Test_Wiki_Bold;

   --  ------------------------------
   --  Test italic rendering.
   --  ------------------------------
   procedure Test_Wiki_Italic (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, "
item
",
                                Wiki.Utils.To_Html ("_item_", SYNTAX_GOOGLE),
                                "Italic rendering invalid");
      Util.Tests.Assert_Equals (T, "
x item y
",
                                Wiki.Utils.To_Html ("x _item_ y", SYNTAX_GOOGLE),
                                "Italic rendering invalid");
      Util.Tests.Assert_Equals (T, "
x item y
",
                                Wiki.Utils.To_Html ("x _item y", SYNTAX_MIX),
                                "Italic rendering invalid");
      Util.Tests.Assert_Equals (T, "
x item y p
",
                                Wiki.Utils.To_Html ("x ''item y'' p", SYNTAX_DOTCLEAR),
                                "Italic rendering invalid");
      Util.Tests.Assert_Equals (T, "
x item y p
",
                                Wiki.Utils.To_Html ("x ''item y'' p", SYNTAX_PHPBB),
                                "Italic rendering invalid");
      Util.Tests.Assert_Equals (T, "
x 'item y p
",
                                Wiki.Utils.To_Html ("x 'item y'' p", SYNTAX_PHPBB),
                                "Italic rendering invalid");
   end Test_Wiki_Italic;

   --  ------------------------------
   --  Test various format rendering.
   --  ------------------------------
   procedure Test_Wiki_Formats (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, "
itboldem
",
                                Wiki.Utils.To_Html ("_it*bold*em_", SYNTAX_GOOGLE),
                                "Italic+Bold rendering invalid");
      Util.Tests.Assert_Equals (T, "
x item y
",
                                Wiki.Utils.To_Html ("x _item_ y", SYNTAX_GOOGLE),
                                "Italic rendering invalid");
      Util.Tests.Assert_Equals (T, "
x item y
",
                                Wiki.Utils.To_Html ("x _item y", SYNTAX_GOOGLE),
                                "Italic rendering invalid");
   end Test_Wiki_Formats;

   --  ------------------------------
   --  Test heading rendering.
   --  ------------------------------
   procedure Test_Wiki_Section (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, "
item
",
                                Wiki.Utils.To_Html ("= item =", SYNTAX_GOOGLE),
                                "H1 rendering invalid");
      Util.Tests.Assert_Equals (T, "
item
",
                                Wiki.Utils.To_Html ("== item == ", SYNTAX_GOOGLE),
                                "H2 rendering invalid");
      Util.Tests.Assert_Equals (T, "
item
",
                                Wiki.Utils.To_Html ("=== item  ===  ", SYNTAX_GOOGLE),
                                "H3 rendering invalid");
      Util.Tests.Assert_Equals (T, "
item
",
                                Wiki.Utils.To_Html ("==== item ==== ", SYNTAX_GOOGLE),
                                "H4 rendering invalid");
      Util.Tests.Assert_Equals (T, "
item
",
                                Wiki.Utils.To_Html ("===== item =====", SYNTAX_GOOGLE),
                                "H5 rendering invalid");
      Util.Tests.Assert_Equals (T, "
item
",
                                Wiki.Utils.To_Html ("====== item ===", SYNTAX_GOOGLE),
                                "H6 rendering invalid");
      Util.Tests.Assert_Equals (T, "
item

item2
",
                                Wiki.Utils.To_Html ("= item =" & CR & "== item2 ==",
                                  SYNTAX_GOOGLE),
                                "H1 rendering invalid");
      Util.Tests.Assert_Equals (T, "
item

item2
",
        Wiki.Utils.To_Html ("= item =" & CR & "== item2 ==",
          SYNTAX_GOOGLE),
        "H1 rendering invalid");
   end Test_Wiki_Section;

   --  ------------------------------
   --  Test list rendering.
   --  ------------------------------
   procedure Test_Wiki_List (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, "

item

",
                                Wiki.Utils.To_Html ("# item", SYNTAX_GOOGLE),
                                "Ordered list rendering invalid");
      Util.Tests.Assert_Equals (T, "

item item " & ASCII.LF &
                                "

item2 item2" & ASCII.LF &
                                "

item3

",
        Wiki.Utils.To_Html ("# item item " & LF & "# item2 item2" & LF & "## item3",
         SYNTAX_GOOGLE),
        "Ordered rendering invalid");

      Util.Tests.Assert_Equals (T, "

item

",
                                Wiki.Utils.To_Html (" * item", SYNTAX_GOOGLE),
                                "Bullet list rendering invalid");

      Util.Tests.Assert_Equals (T, "

item

",
                                Wiki.Utils.To_Html ("* item", SYNTAX_DOTCLEAR),
                                "Bullet list rendering invalid");

   end Test_Wiki_List;

   --  ------------------------------
   --  Test link rendering.
   --  ------------------------------
   procedure Test_Wiki_Link (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, "
name
",
                                Wiki.Utils.To_Html ("[name]", SYNTAX_GOOGLE),
                                "Link rendering invalid");
      Util.Tests.Assert_Equals (T, "
name
",
                                Wiki.Utils.To_Html ("[name |http://www.joe.com/item|en|some]",
                                SYNTAX_DOTCLEAR),
                                "Link rendering invalid");
      Util.Tests.Assert_Equals (T, "
name
",
                                Wiki.Utils.To_Html ("[[name]]", SYNTAX_CREOLE),
                                "Link rendering invalid");
      Util.Tests.Assert_Equals (T, "
[d
",
                                Wiki.Utils.To_Html ("[d", SYNTAX_CREOLE),
                                "No link rendering invalid");
      Util.Tests.Assert_Equals (T, "
http://www.joe.com/item
",
                                Wiki.Utils.To_Html ("[http://www.joe.com/item]",
                                SYNTAX_DOTCLEAR),
                                "Link rendering invalid");
      Util.Tests.Assert_Equals (T, "
name
",
                                Wiki.Utils.To_Html ("[[name]]", SYNTAX_MEDIA_WIKI),
                                "Link rendering invalid");
   end Test_Wiki_Link;

   --  ------------------------------
   --  Test quote rendering.
   --  ------------------------------
   procedure Test_Wiki_Quote (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, "
<q>quote</q>
",
                                Wiki.Utils.To_Html ("{{quote}}", SYNTAX_DOTCLEAR),
                                "Quote rendering invalid");
      Util.Tests.Assert_Equals (T, "
<q lang=""en"">quote</q>
",
                                Wiki.Utils.To_Html ("{{quote|en}}", SYNTAX_DOTCLEAR),
                                "Quote rendering invalid");
      Util.Tests.Assert_Equals (T, "
<q cite=""http://www.sun.com"" lang=""en"">quote</q>
",
                                Wiki.Utils.To_Html ("{{quote|en|http://www.sun.com}}",
                                                 SYNTAX_DOTCLEAR),
                                "Quote rendering invalid");
      Util.Tests.Assert_Equals (T, "
{quote}}
",
                                Wiki.Utils.To_Html ("{quote}}", SYNTAX_DOTCLEAR),
                                "No quote rendering invalid");
   end Test_Wiki_Quote;

   --  ------------------------------
   --  Test line break rendering.
   --  ------------------------------
   procedure Test_Wiki_Line_Break (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, "
a
b
",
                                Wiki.Utils.To_Html ("a%%%b", SYNTAX_DOTCLEAR),
                                "Line break rendering invalid");
      Util.Tests.Assert_Equals (T, "
a
b
",
                                Wiki.Utils.To_Html ("a\\b", SYNTAX_CREOLE),
                                "Line break rendering invalid");
      Util.Tests.Assert_Equals (T, "
a%%b
",
                                Wiki.Utils.To_Html ("a%%b", SYNTAX_DOTCLEAR),
                                "No line break rendering invalid");
      Util.Tests.Assert_Equals (T, "
a%b
",
                                Wiki.Utils.To_Html ("a%b", SYNTAX_DOTCLEAR),
                                "No line break rendering invalid");
   end Test_Wiki_Line_Break;

   --  ------------------------------
   --  Test image rendering.
   --  ------------------------------
   procedure Test_Wiki_Image (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, "

",
                                Wiki.Utils.To_Html ("((/image/t.png))", SYNTAX_DOTCLEAR),
                                "Image rendering invalid");
      Util.Tests.Assert_Equals (T, "

",
                                Wiki.Utils.To_Html ("((/image/t.png|title))", SYNTAX_DOTCLEAR),
                                "Image rendering invalid");
      Util.Tests.Assert_Equals (T, "

",
                                Wiki.Utils.To_Html ("((/image/t.png|title|D|describe))",
                                                 SYNTAX_DOTCLEAR),
                                "Image rendering invalid");
   end Test_Wiki_Image;

   --  ------------------------------
   --  Test preformatted rendering.
   --  ------------------------------
   procedure Test_Wiki_Preformatted (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, "
<tt>code</tt>
",
                                Wiki.Utils.To_Html ("{{{code}}}", SYNTAX_GOOGLE),
                                "Preformat rendering invalid");
      Util.Tests.Assert_Equals (T, "
* code *" & ASCII.LF & "
",
                                Wiki.Utils.To_Html ("///" & LF & "* code *" & LF & "///",
                                                 SYNTAX_DOTCLEAR),
                                "Preformat rendering invalid");
      Util.Tests.Assert_Equals (T, "
item1 x" & ASCII.LF & "item2 x" & ASCII.LF & "item3 x"
                                & ASCII.LF & "
",
                                Wiki.Utils.To_Html (" item1 x" & LF & " item2 x" & LF & " item3 x",
                                                 SYNTAX_DOTCLEAR),
                                "Preformat rendering invalid");
      Util.Tests.Assert_Equals (T, "
item1 x" & ASCII.LF & "item2 x"
                                & ASCII.LF & "item3 x"
                                & ASCII.LF & "
",
                                Wiki.Utils.To_Html (" item1 x" & CR & LF & " item2 x"
                                  & CR & LF & " item3 x",
                                                 SYNTAX_DOTCLEAR),
                                "Preformat rendering invalid");
   end Test_Wiki_Preformatted;

   --  ------------------------------
   --  Test the text renderer.
   --  ------------------------------
   procedure Test_Wiki_Text_Renderer (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, ASCII.LF & "code",
                                Wiki.Utils.To_Text ("{{{code}}}", SYNTAX_GOOGLE),
                                "Preformat rendering invalid");
      Util.Tests.Assert_Equals (T, ASCII.LF & "bold item my_title" & ASCII.LF,
                                Wiki.Utils.To_Text ("_bold_ __item__ [my_title]", SYNTAX_GOOGLE),
                                "Preformat rendering invalid");

   end Test_Wiki_Text_Renderer;

end Wiki.Parsers.Tests;

Update the unit test

Update the unit test


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

with Util.Test_Caller;

with Security.Contexts;

with AWA.Users.Models;
with AWA.Services.Contexts;
with AWA.Votes.Modules;
with AWA.Tests.Helpers.Users;
package body AWA.Tags.Modules.Tests is

   use Util.Tests;
   use ADO;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Tags.Modules.Add_Tag",
                       Test_Add_Tag'Access);
      Caller.Add_Test (Suite, "Test AWA.Tags.Modules.Remove_Tag",
                       Test_Remove_Tag'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test tag creation.
   --  ------------------------------
   procedure Test_Add_Tag (T : in out Test) is
      Sec_Ctx      : Security.Contexts.Security_Context;
      Context      : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-tag@test.com");

      declare
         Tag_Manager  : constant Tag_Module_Access := Get_Tag_Module;
         User         : constant AWA.Users.Models.User_Ref := Context.Get_User;
      begin
         T.Assert (Tag_Manager /= null, "There is no tag module");

         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag");

         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag");
      end;
   end Test_Add_Tag;

   --  ------------------------------
   --  Test tag removal.
   --  ------------------------------
   procedure Test_Remove_Tag (T : in out Test) is
      Sec_Ctx      : Security.Contexts.Security_Context;
      Context      : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-tag@test.com");

      declare
         Tag_Manager  : constant Tag_Module_Access := Get_Tag_Module;
         User         : constant AWA.Users.Models.User_Ref := Context.Get_User;
      begin
         T.Assert (Tag_Manager /= null, "There is no tag module");

         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-1");
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-2");
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-3");

         Tag_Manager.Remove_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-2");
         Tag_Manager.Remove_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-1");
      end;
   end Test_Remove_Tag;

end AWA.Tags.Modules.Tests;

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

with Util.Test_Caller;
with Util.Beans.Basic;
with Util.Beans.Objects;

with Security.Contexts;

with AWA.Users.Models;
with AWA.Services.Contexts;
with AWA.Tests.Helpers.Users;
with AWA.Tags.Beans;
package body AWA.Tags.Modules.Tests is

   use Util.Tests;
   use ADO;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Tags.Modules.Add_Tag",
                       Test_Add_Tag'Access);
      Caller.Add_Test (Suite, "Test AWA.Tags.Modules.Remove_Tag",
                       Test_Remove_Tag'Access);
   end Add_Tests;

   function Create_Tag_List_Bean (Module : in Tag_Module_Access)
                                  return AWA.Tags.Beans.Tag_List_Bean_Access is
      Bean : Util.Beans.Basic.Readonly_Bean_Access := AWA.Tags.Beans.Create_Tag_List_Bean (Module);
   begin
      return AWA.Tags.Beans.Tag_List_Bean'Class (Bean.all)'Access;
   end Create_Tag_List_Bean;

   --  ------------------------------
   --  Test tag creation.
   --  ------------------------------
   procedure Test_Add_Tag (T : in out Test) is
      Sec_Ctx      : Security.Contexts.Security_Context;
      Context      : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-add-tag@test.com");

      declare
         Tag_Manager  : constant Tag_Module_Access := Get_Tag_Module;
         User         : constant AWA.Users.Models.User_Ref := Context.Get_User;
         List         : AWA.Tags.Beans.Tag_List_Bean_Access;
         Cleanup      : Util.Beans.Objects.Object;
      begin
         T.Assert (Tag_Manager /= null, "There is no tag module");

         List := Create_Tag_List_Bean (Tag_Manager);
         Cleanup := Util.Beans.Objects.To_Object (List.all'Access);
         List.Set_Value ("entity_type", Util.Beans.Objects.To_Object (String '("awa_user")));

         --  Create a tag.
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag");
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag");

         --  Load the list.
         List.Load_Tags (User.Get_Id);

         Util.Tests.Assert_Equals (T, 1, Integer (List.Get_Count), "Invalid number of tags");
      end;
   end Test_Add_Tag;

   --  ------------------------------
   --  Test tag removal.
   --  ------------------------------
   procedure Test_Remove_Tag (T : in out Test) is
      Sec_Ctx      : Security.Contexts.Security_Context;
      Context      : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-tag@test.com");

      declare
         Tag_Manager  : constant Tag_Module_Access := Get_Tag_Module;
         User         : constant AWA.Users.Models.User_Ref := Context.Get_User;
         List         : AWA.Tags.Beans.Tag_List_Bean_Access;
         Cleanup      : Util.Beans.Objects.Object;
      begin
         T.Assert (Tag_Manager /= null, "There is no tag module");

         List := Create_Tag_List_Bean (Tag_Manager);
         Cleanup := Util.Beans.Objects.To_Object (List.all'Access);
         List.Set_Value ("entity_type", Util.Beans.Objects.To_Object (String '("awa_user")));

         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-1");
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-2");
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-3");

         Tag_Manager.Remove_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-2");
         Tag_Manager.Remove_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-1");

         --  Load the list.
         List.Load_Tags (User.Get_Id);
         Util.Tests.Assert_Equals (T, 2, Integer (List.Get_Count), "Invalid number of tags");
      end;
   end Test_Remove_Tag;

end AWA.Tags.Modules.Tests;

Use the Tag_List_Bean to check that the tags are created/removed


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

with Util.Concurrent.Counters;

with MAT.Frames;
package MAT.Events.Targets is

   type Event_Type is mod 16;
   type Probe_Index_Type is mod 16;

   type Probe_Event_Type is record
      Event    : MAT.Types.Uint16;
      Index    : Probe_Index_Type;
      Time     : MAT.Types.Target_Time;
      Thread   : MAT.Types.Target_Thread_Ref;
      Frame    : MAT.Frames.Frame_Type;
      Addr     : MAT.Types.Target_Addr;
      Size     : MAT.Types.Target_Size;
      Old_Addr : MAT.Types.Target_Addr;
   end record;

   subtype Target_Event is Probe_Event_Type;

   package Target_Event_Vectors is
     new Ada.Containers.Vectors (Positive, Target_Event);

   subtype Target_Event_Vector is Target_Event_Vectors.Vector;
   subtype Target_Event_Cursor is Target_Event_Vectors.Cursor;

   type Target_Events is tagged limited private;
   type Target_Events_Access is access all Target_Events'Class;

   --  Add the event in the list of events and increment the event counter.
   procedure Insert (Target : in out Target_Events;
                     Event  : in Probe_Event_Type);

   procedure Get_Events (Target : in out Target_Events;
                         Start  : in MAT.Types.Target_Time;
                         Finish : in MAT.Types.Target_Time;
                         Into   : in out Target_Event_Vector);

   --  Get the current event counter.
   function Get_Event_Counter (Target : in Target_Events) return Integer;

private

   EVENT_BLOCK_SIZE : constant Positive := 1024;

   type Probe_Event_Array is array (1 .. EVENT_BLOCK_SIZE) of Probe_Event_Type;

   type Event_Block is record
      Start  : MAT.Types.Target_Time;
      Finish : MAT.Types.Target_Time;
      Count  : Natural := 0;
      Events : Probe_Event_Array;
   end record;
   type Event_Block_Access is access all Event_Block;

   use type MAT.Types.Target_Time;
   package Event_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Time,
                                      Element_Type => Event_Block_Access);

   subtype Event_Map is Event_Maps.Map;
   subtype Event_Cursor is Event_Maps.Cursor;

   protected type Event_Collector is

      --  Add the event in the list of events.
      procedure Insert (Event  : in Probe_Event_Type);

      procedure Get_Events (Start  : in MAT.Types.Target_Time;
                            Finish : in MAT.Types.Target_Time;
                            Into   : in out Target_Event_Vector);

   private
      Current       : Event_Block_Access := null;
      Events        : Event_Map;
   end Event_Collector;

   type Target_Events is tagged limited record
      Events      : Event_Collector;
      Event_Count : Util.Concurrent.Counters.Counter;
   end record;

end MAT.Events.Targets;

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

with Util.Concurrent.Counters;

with MAT.Frames;
package MAT.Events.Targets is

   type Event_Type is mod 16;
   type Probe_Index_Type is mod 16;

   type Probe_Event_Type is record
      Event    : MAT.Types.Uint16;
      Index    : Probe_Index_Type;
      Time     : MAT.Types.Target_Time;
      Thread   : MAT.Types.Target_Thread_Ref;
      Frame    : MAT.Frames.Frame_Type;
      Addr     : MAT.Types.Target_Addr;
      Size     : MAT.Types.Target_Size;
      Old_Addr : MAT.Types.Target_Addr;
   end record;

   subtype Target_Event is Probe_Event_Type;

   package Target_Event_Vectors is
     new Ada.Containers.Vectors (Positive, Target_Event);

   subtype Target_Event_Vector is Target_Event_Vectors.Vector;
   subtype Target_Event_Cursor is Target_Event_Vectors.Cursor;

   type Target_Events is tagged limited private;
   type Target_Events_Access is access all Target_Events'Class;

   --  Add the event in the list of events and increment the event counter.
   procedure Insert (Target : in out Target_Events;
                     Event  : in Probe_Event_Type);

   procedure Get_Events (Target : in out Target_Events;
                         Start  : in MAT.Types.Target_Time;
                         Finish : in MAT.Types.Target_Time;
                         Into   : in out Target_Event_Vector);

   --  Get the current event counter.
   function Get_Event_Counter (Target : in Target_Events) return Integer;

private

   EVENT_BLOCK_SIZE : constant Positive := 1024;

   type Probe_Event_Array is array (1 .. EVENT_BLOCK_SIZE) of Probe_Event_Type;

   type Event_Block is record
      Start  : MAT.Types.Target_Time;
      Finish : MAT.Types.Target_Time;
      Count  : Natural := 0;
      Events : Probe_Event_Array;
   end record;
   type Event_Block_Access is access all Event_Block;

   use type MAT.Types.Target_Time;
   package Event_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Time,
                                      Element_Type => Event_Block_Access);

   subtype Event_Map is Event_Maps.Map;
   subtype Event_Cursor is Event_Maps.Cursor;

   protected type Event_Collector is

      --  Add the event in the list of events.
      procedure Insert (Event  : in Probe_Event_Type);

      procedure Get_Events (Start  : in MAT.Types.Target_Time;
                            Finish : in MAT.Types.Target_Time;
                            Into   : in out Target_Event_Vector);

      --  Get the start and finish time for the events that have been received.
      procedure Get_Time_Range (Start  : out MAT.Types.Target_Time;
                                Finish : out MAT.Types.Target_Time);

   private
      Current       : Event_Block_Access := null;
      Events        : Event_Map;
   end Event_Collector;

   type Target_Events is tagged limited record
      Events      : Event_Collector;
      Event_Count : Util.Concurrent.Counters.Counter;
   end record;

end MAT.Events.Targets;

Declare the Get_Time_Range protected procedure


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

with MAT.Memory.Readers;
package body MAT.Memory.Targets is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Memory.Targets");

   --  ------------------------------
   --  Initialize the target memory object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory events.
   --  ------------------------------
   procedure Initialize (Memory : in out Target_Memory;
                         Reader : in out MAT.Readers.Manager_Base'Class) is
      Memory_Reader : constant MAT.Memory.Readers.Memory_Reader_Access
        := new MAT.Memory.Readers.Memory_Servant;
   begin
      Memory.Reader := Memory_Reader.all'Access;
      Memory_Reader.Data := Memory'Unrestricted_Access;
      MAT.Memory.Readers.Register (Reader, Memory_Reader);
   end Initialize;

   --  ------------------------------
   --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
   --  in the used slots map.  The freed slots that intersect the malloc'ed region are
   --  removed from the freed map.
   --  ------------------------------
   procedure Probe_Malloc (Memory : in out Target_Memory;
                           Addr   : in MAT.Types.Target_Addr;
                           Slot   : in Allocation) is
   begin
      Memory.Memory.Probe_Malloc (Addr, Slot);
   end Probe_Malloc;

   --  ------------------------------
   --  Take into account a free probe.  Add the memory slot in the freed map and remove
   --  the slot from the used slots map.
   --  ------------------------------
   procedure Probe_Free (Memory : in out Target_Memory;
                         Addr   : in MAT.Types.Target_Addr;
                         Slot   : in Allocation) is
   begin
      Memory.Memory.Probe_Free (Addr, Slot);
   end Probe_Free;

   --  ------------------------------
   --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
   --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
   --  inserted in the used slots map.
   --  ------------------------------
   procedure Probe_Realloc (Memory : in out Target_Memory;
                            Addr     : in MAT.Types.Target_Addr;
                            Old_Addr : in MAT.Types.Target_Addr;
                            Slot     : in Allocation) is
   begin
      Memory.Memory.Probe_Realloc (Addr, Old_Addr, Slot);
   end Probe_Realloc;

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

   --  ------------------------------
   --  Collect the information about memory slot sizes allocated by the application.
   --  ------------------------------
   procedure Size_Information (Memory : in out Target_Memory;
                               Sizes  : in out MAT.Memory.Tools.Size_Info_Map) is
   begin
      Memory.Memory.Size_Information (Sizes);
   end Size_Information;

   --  ------------------------------
   --  Collect the information about threads and the memory allocations they've made.
   --  ------------------------------
   procedure Thread_Information (Memory  : in out Target_Memory;
                                 Threads : in out Memory_Info_Map) is
   begin
      Memory.Memory.Thread_Information (Threads);
   end Thread_Information;

   --  ------------------------------
   --  Collect the information about frames and the memory allocations they've made.
   --  ------------------------------
   procedure Frame_Information (Memory : in out Target_Memory;
                                Level  : in Natural;
                                Frames : in out Frame_Info_Map) is
   begin
      Memory.Memory.Frame_Information (Level, Frames);
   end Frame_Information;

   --  ------------------------------
   --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
   --  the region [From .. To] and which is selected by the given filter expression.
   --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
   --  the memory slot.
   --  ------------------------------
   procedure Find (Memory : in out Target_Memory;
                   From   : in MAT.Types.Target_Addr;
                   To     : in MAT.Types.Target_Addr;
                   Filter : in MAT.Expressions.Expression_Type;
                   Into   : in out MAT.Memory.Allocation_Map) is
   begin
      Memory.Memory.Find (From, To, Filter, Into);
   end Find;

   protected body Memory_Allocator is

      --  ------------------------------
      --  Remove the memory region [Addr .. Addr + Size] from the free list.
      --  ------------------------------
      procedure Remove_Free (Addr : in MAT.Types.Target_Addr;
                             Size : in MAT.Types.Target_Size) is
         Iter : Allocation_Cursor;
         Last : constant MAT.Types.Target_Addr := Addr + MAT.Types.Target_Addr (Size);
         Slot : Allocation;
      begin
         --  Walk the list of free blocks and remove all the blocks which intersect the region
         --  [Addr .. Addr + Slot.Size].  We start walking at the first block below and near
         --  the address.  Slots are then removed when they intersect the malloc'ed region.
         Iter := Freed_Slots.Floor (Addr);
         while Allocation_Maps.Has_Element (Iter) loop
            declare
               Freed_Addr : constant MAT.Types.Target_Addr := Allocation_Maps.Key (Iter);
            begin
               exit when Freed_Addr > Last;
               Slot := Allocation_Maps.Element (Iter);
               if Freed_Addr + MAT.Types.Target_Addr (Slot.Size) > Addr then
                  if Stats.Total_Free > Slot.Size then
                     Stats.Total_Free := Stats.Total_Free - Slot.Size;
                  else
                     Stats.Total_Free := 0;
                  end if;
                  Freed_Slots.Delete (Iter);
                  Iter := Freed_Slots.Floor (Addr);
               else
                  Allocation_Maps.Next (Iter);
               end if;
            end;
         end loop;
      end Remove_Free;

      --  ------------------------------
      --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
      --  in the used slots map.  The freed slots that intersect the malloc'ed region are
      --  removed from the freed map.
      --  ------------------------------
      procedure Probe_Malloc (Addr   : in MAT.Types.Target_Addr;
                              Slot   : in Allocation) is
      begin
         if Log.Get_Level = Util.Log.DEBUG_LEVEL then
            Log.Debug ("Malloc at {0} size {1}", MAT.Types.Hex_Image (Addr),
                       MAT.Types.Target_Size'Image (Slot.Size));
         end if;
         Stats.Malloc_Count := Stats.Malloc_Count + 1;
         Stats.Total_Alloc := Stats.Total_Alloc + Slot.Size;
         Remove_Free (Addr, Slot.Size);
         Used_Slots.Insert (Addr, Slot);
      end Probe_Malloc;

      --  ------------------------------
      --  Take into account a free probe.  Add the memory slot in the freed map and remove
      --  the slot from the used slots map.
      --  ------------------------------
      procedure Probe_Free (Addr   : in MAT.Types.Target_Addr;
                            Slot   : in Allocation) is
         Item : Allocation;
         Iter : Allocation_Cursor;
      begin
         if Log.Get_Level = Util.Log.DEBUG_LEVEL then
            Log.Debug ("Free {0}", MAT.Types.Hex_Image (Addr));
         end if;
         Stats.Free_Count := Stats.Free_Count + 1;
         Iter := Used_Slots.Find (Addr);
         if Allocation_Maps.Has_Element (Iter) then
            Item := Allocation_Maps.Element (Iter);
            if Stats.Total_Alloc >= Item.Size then
               Stats.Total_Alloc := Stats.Total_Alloc - Item.Size;
            else
               Stats.Total_Alloc := 0;
            end if;
            Stats.Total_Free := Stats.Total_Free + Item.Size;
            MAT.Frames.Release (Item.Frame);
            Used_Slots.Delete (Iter);
            Item.Frame := Slot.Frame;
            Freed_Slots.Insert (Addr, Item);
         end if;
      end Probe_Free;

      --  ------------------------------
      --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
      --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
      --  inserted in the used slots map.
      --  ------------------------------
      procedure Probe_Realloc (Addr     : in MAT.Types.Target_Addr;
                               Old_Addr : in MAT.Types.Target_Addr;
                               Slot     : in Allocation) is
         procedure Update_Size (Key     : in MAT.Types.Target_Addr;
                                Element : in out Allocation);

         procedure Update_Size (Key     : in MAT.Types.Target_Addr;
                                Element : in out Allocation) is
            pragma Unreferenced (Key);
         begin
            if Stats.Total_Alloc >= Element.Size then
               Stats.Total_Alloc := Stats.Total_Alloc - Element.Size;
            else
               Stats.Total_Alloc := 0;
            end if;
            Element.Size := Slot.Size;
            MAT.Frames.Release (Element.Frame);
            Element.Frame := Slot.Frame;
         end Update_Size;

         Pos      : Allocation_Cursor;
      begin
         if Log.Get_Level = Util.Log.DEBUG_LEVEL then
            Log.Debug ("Realloc {0} to {1} size {2}", MAT.Types.Hex_Image (Old_Addr),
                       MAT.Types.Hex_Image (Addr), MAT.Types.Target_Size'Image (Slot.Size));
         end if;
         Stats.Realloc_Count := Stats.Realloc_Count + 1;
         if Addr /= 0 then
            Stats.Total_Alloc := Stats.Total_Alloc + Slot.Size;
            Pos := Used_Slots.Find (Old_Addr);
            if Allocation_Maps.Has_Element (Pos) then
               if Addr = Old_Addr then
                  Used_Slots.Update_Element (Pos, Update_Size'Access);
               else
                  Used_Slots.Delete (Pos);
                  Used_Slots.Insert (Addr, Slot);
               end if;
            else
               Used_Slots.Insert (Addr, Slot);
            end if;
            Remove_Free (Addr, Slot.Size);
         end if;
      end Probe_Realloc;

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

      --  ------------------------------
      --  Collect the information about memory slot sizes allocated by the application.
      --  ------------------------------
      procedure Size_Information (Sizes  : in out MAT.Memory.Tools.Size_Info_Map) is
      begin
         MAT.Memory.Tools.Size_Information (Used_Slots, Sizes);
      end Size_Information;

      --  ------------------------------
      --  Collect the information about threads and the memory allocations they've made.
      --  ------------------------------
      procedure Thread_Information (Threads : in out Memory_Info_Map) is
      begin
         MAT.Memory.Tools.Thread_Information (Used_Slots, Threads);
      end Thread_Information;

      --  ------------------------------
      --  Collect the information about frames and the memory allocations they've made.
      --  ------------------------------
      procedure Frame_Information (Level  : in Natural;
                                   Frames : in out Frame_Info_Map) is
      begin
         MAT.Memory.Tools.Frame_Information (Used_Slots, Level, Frames);
      end Frame_Information;

      --  ------------------------------
      --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
      --  the region [From .. To] and which is selected by the given filter expression.
      --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
      --  the memory slot.
      --  ------------------------------
      procedure Find (From   : in MAT.Types.Target_Addr;
                      To     : in MAT.Types.Target_Addr;
                      Filter : in MAT.Expressions.Expression_Type;
                      Into   : in out MAT.Memory.Allocation_Map) is
      begin
         MAT.Memory.Tools.Find (Used_Slots, From, To, Filter, Into);
      end Find;

   end Memory_Allocator;

end MAT.Memory.Targets;

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

with MAT.Memory.Readers;
package body MAT.Memory.Targets is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Memory.Targets");

   --  ------------------------------
   --  Initialize the target memory object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory events.
   --  ------------------------------
   procedure Initialize (Memory : in out Target_Memory;
                         Reader : in out MAT.Readers.Manager_Base'Class) is
      Memory_Reader : constant MAT.Memory.Readers.Memory_Reader_Access
        := new MAT.Memory.Readers.Memory_Servant;
   begin
      Memory.Reader := Memory_Reader.all'Access;
      Memory_Reader.Data := Memory'Unrestricted_Access;
      MAT.Memory.Readers.Register (Reader, Memory_Reader);
   end Initialize;

   --  ------------------------------
   --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
   --  in the used slots map.  The freed slots that intersect the malloc'ed region are
   --  removed from the freed map.
   --  ------------------------------
   procedure Probe_Malloc (Memory : in out Target_Memory;
                           Addr   : in MAT.Types.Target_Addr;
                           Slot   : in Allocation) is
   begin
      Memory.Memory.Probe_Malloc (Addr, Slot);
   end Probe_Malloc;

   --  ------------------------------
   --  Take into account a free probe.  Add the memory slot in the freed map and remove
   --  the slot from the used slots map.
   --  ------------------------------
   procedure Probe_Free (Memory : in out Target_Memory;
                         Addr   : in MAT.Types.Target_Addr;
                         Slot   : in Allocation) is
   begin
      Memory.Memory.Probe_Free (Addr, Slot);
   end Probe_Free;

   --  ------------------------------
   --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
   --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
   --  inserted in the used slots map.
   --  ------------------------------
   procedure Probe_Realloc (Memory : in out Target_Memory;
                            Addr     : in MAT.Types.Target_Addr;
                            Old_Addr : in MAT.Types.Target_Addr;
                            Slot     : in Allocation) is
   begin
      Memory.Memory.Probe_Realloc (Addr, Old_Addr, Slot);
   end Probe_Realloc;

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

   --  ------------------------------
   --  Collect the information about memory slot sizes allocated by the application.
   --  ------------------------------
   procedure Size_Information (Memory : in out Target_Memory;
                               Sizes  : in out MAT.Memory.Tools.Size_Info_Map) is
   begin
      Memory.Memory.Size_Information (Sizes);
   end Size_Information;

   --  ------------------------------
   --  Collect the information about threads and the memory allocations they've made.
   --  ------------------------------
   procedure Thread_Information (Memory  : in out Target_Memory;
                                 Threads : in out Memory_Info_Map) is
   begin
      Memory.Memory.Thread_Information (Threads);
   end Thread_Information;

   --  ------------------------------
   --  Collect the information about frames and the memory allocations they've made.
   --  ------------------------------
   procedure Frame_Information (Memory : in out Target_Memory;
                                Level  : in Natural;
                                Frames : in out Frame_Info_Map) is
   begin
      Memory.Memory.Frame_Information (Level, Frames);
   end Frame_Information;

   --  ------------------------------
   --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
   --  the region [From .. To] and which is selected by the given filter expression.
   --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
   --  the memory slot.
   --  ------------------------------
   procedure Find (Memory : in out Target_Memory;
                   From   : in MAT.Types.Target_Addr;
                   To     : in MAT.Types.Target_Addr;
                   Filter : in MAT.Expressions.Expression_Type;
                   Into   : in out MAT.Memory.Allocation_Map) is
   begin
      Memory.Memory.Find (From, To, Filter, Into);
   end Find;

   protected body Memory_Allocator is

      --  ------------------------------
      --  Remove the memory region [Addr .. Addr + Size] from the free list.
      --  ------------------------------
      procedure Remove_Free (Addr : in MAT.Types.Target_Addr;
                             Size : in MAT.Types.Target_Size) is
         Iter : Allocation_Cursor;
         Last : constant MAT.Types.Target_Addr := Addr + MAT.Types.Target_Addr (Size);
         Slot : Allocation;
      begin
         --  Walk the list of free blocks and remove all the blocks which intersect the region
         --  [Addr .. Addr + Slot.Size].  We start walking at the first block below and near
         --  the address.  Slots are then removed when they intersect the malloc'ed region.
         Iter := Freed_Slots.Floor (Addr);
         while Allocation_Maps.Has_Element (Iter) loop
            declare
               Freed_Addr : constant MAT.Types.Target_Addr := Allocation_Maps.Key (Iter);
            begin
               exit when Freed_Addr > Last;
               Slot := Allocation_Maps.Element (Iter);
               if Freed_Addr + MAT.Types.Target_Addr (Slot.Size) > Addr then
                  if Stats.Total_Free > Slot.Size then
                     Stats.Total_Free := Stats.Total_Free - Slot.Size;
                  else
                     Stats.Total_Free := 0;
                  end if;
                  Freed_Slots.Delete (Iter);
                  Iter := Freed_Slots.Floor (Addr);
               else
                  Allocation_Maps.Next (Iter);
               end if;
            end;
         end loop;
      end Remove_Free;

      --  ------------------------------
      --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
      --  in the used slots map.  The freed slots that intersect the malloc'ed region are
      --  removed from the freed map.
      --  ------------------------------
      procedure Probe_Malloc (Addr   : in MAT.Types.Target_Addr;
                              Slot   : in Allocation) is
      begin
         if Log.Get_Level = Util.Log.DEBUG_LEVEL then
            Log.Debug ("Malloc at {0} size {1}", MAT.Types.Hex_Image (Addr),
                       MAT.Types.Target_Size'Image (Slot.Size));
         end if;
         Stats.Malloc_Count := Stats.Malloc_Count + 1;
         Stats.Total_Alloc := Stats.Total_Alloc + Slot.Size;
         Remove_Free (Addr, Slot.Size);
         Used_Slots.Insert (Addr, Slot);
      end Probe_Malloc;

      --  ------------------------------
      --  Take into account a free probe.  Add the memory slot in the freed map and remove
      --  the slot from the used slots map.
      --  ------------------------------
      procedure Probe_Free (Addr   : in MAT.Types.Target_Addr;
                            Slot   : in Allocation) is
         Item : Allocation;
         Iter : Allocation_Cursor;
      begin
         if Log.Get_Level = Util.Log.DEBUG_LEVEL then
            Log.Debug ("Free {0}", MAT.Types.Hex_Image (Addr));
         end if;
         Stats.Free_Count := Stats.Free_Count + 1;
         Iter := Used_Slots.Find (Addr);
         if Allocation_Maps.Has_Element (Iter) then
            Item := Allocation_Maps.Element (Iter);
            if Stats.Total_Alloc >= Item.Size then
               Stats.Total_Alloc := Stats.Total_Alloc - Item.Size;
            else
               Stats.Total_Alloc := 0;
            end if;
            Stats.Total_Free := Stats.Total_Free + Item.Size;
            MAT.Frames.Release (Item.Frame);
            Used_Slots.Delete (Iter);
            Item.Frame := Slot.Frame;
            Freed_Slots.Insert (Addr, Item);
         end if;
      end Probe_Free;

      --  ------------------------------
      --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
      --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
      --  inserted in the used slots map.
      --  ------------------------------
      procedure Probe_Realloc (Addr     : in MAT.Types.Target_Addr;
                               Old_Addr : in MAT.Types.Target_Addr;
                               Slot     : in Allocation) is
         procedure Update_Size (Key     : in MAT.Types.Target_Addr;
                                Element : in out Allocation);

         procedure Update_Size (Key     : in MAT.Types.Target_Addr;
                                Element : in out Allocation) is
            pragma Unreferenced (Key);
         begin
            if Stats.Total_Alloc >= Element.Size then
               Stats.Total_Alloc := Stats.Total_Alloc - Element.Size;
            else
               Stats.Total_Alloc := 0;
            end if;
            Element.Size := Slot.Size;
            MAT.Frames.Release (Element.Frame);
            Element.Frame := Slot.Frame;
         end Update_Size;

         Pos      : Allocation_Cursor;
      begin
         if Log.Get_Level = Util.Log.DEBUG_LEVEL then
            Log.Debug ("Realloc {0} to {1} size {2}", MAT.Types.Hex_Image (Old_Addr),
                       MAT.Types.Hex_Image (Addr), MAT.Types.Target_Size'Image (Slot.Size));
         end if;
         Stats.Realloc_Count := Stats.Realloc_Count + 1;
         if Addr /= 0 then
            Stats.Total_Alloc := Stats.Total_Alloc + Slot.Size;
            Pos := Used_Slots.Find (Old_Addr);
            if Allocation_Maps.Has_Element (Pos) then
               if Addr = Old_Addr then
                  Used_Slots.Update_Element (Pos, Update_Size'Access);
               else
                  Used_Slots.Delete (Pos);
                  Used_Slots.Insert (Addr, Slot);
               end if;
            else
               Used_Slots.Insert (Addr, Slot);
            end if;
            Remove_Free (Addr, Slot.Size);
         end if;
      end Probe_Realloc;

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

      --  ------------------------------
      --  Collect the information about memory slot sizes allocated by the application.
      --  ------------------------------
      procedure Size_Information (Sizes  : in out MAT.Memory.Tools.Size_Info_Map) is
      begin
         MAT.Memory.Tools.Size_Information (Used_Slots, Sizes);
      end Size_Information;

      --  ------------------------------
      --  Collect the information about threads and the memory allocations they've made.
      --  ------------------------------
      procedure Thread_Information (Threads : in out Memory_Info_Map) is
      begin
         MAT.Memory.Tools.Thread_Information (Used_Slots, Threads);
      end Thread_Information;

      --  ------------------------------
      --  Collect the information about frames and the memory allocations they've made.
      --  ------------------------------
      procedure Frame_Information (Level  : in Natural;
                                   Frames : in out Frame_Info_Map) is
      begin
         MAT.Memory.Tools.Frame_Information (Used_Slots, Level, Frames);
      end Frame_Information;

      --  ------------------------------
      --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
      --  the region [From .. To] and which is selected by the given filter expression.
      --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
      --  the memory slot.
      --  ------------------------------
      procedure Find (From   : in MAT.Types.Target_Addr;
                      To     : in MAT.Types.Target_Addr;
                      Filter : in MAT.Expressions.Expression_Type;
                      Into   : in out MAT.Memory.Allocation_Map) is
      begin
         MAT.Memory.Tools.Find (Used_Slots, From, To, Filter, Into);
      end Find;

      --  ------------------------------
      --  Get the global memory and allocation statistics.
      --  ------------------------------
      procedure Stat_Information (Result : out Memory_Stat) is
      begin
         Result := Stats;
      end Stat_Information;

   end Memory_Allocator;

end MAT.Memory.Targets;

Implement the Stat_Information protected operation


-----------------------------------------------------------------------
--  util-encoders -- Encode/Decode streams and strings from one format to another
--  Copyright (C) 2009, 2010, 2011, 2012, 2016, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Streams;
with Ada.Finalization;
with Interfaces;

--  === Encoder and Decoders ===
--  The Util.Encoders package defines the Encoder and Decode objects
--  which provide a mechanism to transform a stream from one format into
--  another format.
--
--  ==== Simple encoding and decoding ====
--
package Util.Encoders is

   pragma Preelaborate;

   Not_Supported  : exception;
   Encoding_Error : exception;

   --  Encoder/decoder for Base64 (RFC 4648)
   BASE_64     : constant String := "base64";

   --  Encoder/decoder for Base64 (RFC 4648) using the URL alphabet
   --  (+ and / are replaced by - and _)
   BASE_64_URL : constant String := "base64url";

   --  Encoder/decoder for Base16 (RFC 4648)
   BASE_16     : constant String := "base16";
   HEX         : constant String := "hex";

   --  Encoder for SHA1 (RFC 3174)
   HASH_SHA1   : constant String := "sha1";

   --  ------------------------------
   --  Encoder context object
   --  ------------------------------
   --  The Encoder provides operations to encode and decode
   --  strings or stream of data from one format to another.
   --  The Encoded contains two Transformer
   --  which either encodes or decodes the stream.
   type Encoder is tagged limited private;

   --  Encodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be encoded.
   --  Raises the Not_Supported exception if the encoding is not
   --  supported.
   function Encode (E    : in Encoder;
                    Data : in String) return String;

   --  Create the encoder object for the specified encoding format.
   function Create (Name : in String) return Encoder;

   type Decoder is tagged limited private;

   --  Decodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be decoded.
   --  Raises the Not_Supported exception if the decoding is not
   --  supported.
   function Decode (E    : in Decoder;
                    Data : in String) return String;

   --  Create the decoder object for the specified encoding format.
   function Create (Name : in String) return Decoder;

   --  ------------------------------
   --  Stream Transformation interface
   --  ------------------------------
   --  The Transformer interface defines the operation to transform
   --  a stream from one data format to another.
   type Transformer is limited interface;
   type Transformer_Access is access all Transformer'Class;

   --  Transform the input array represented by Data into
   --  the output array Into.  The transformation made by
   --  the object can be of any nature (Hex encoding, Base64 encoding,
   --  Hex decoding, Base64 decoding, encryption, compression, ...).
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data array.
   --
   --  The transformer returns in Last the last valid position
   --  in the output array Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  array cannot be transformed.
   procedure Transform (E       : in out Transformer;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset) is abstract;

   --  Finish encoding the input array.
   procedure Finish (E    : in out Transformer;
                     Into : in out Ada.Streams.Stream_Element_Array;
                     Last : in out Ada.Streams.Stream_Element_Offset) is null;

   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   function Transform (E    : in out Transformer'Class;
                       Data : in String) return String;

   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   function Transform (E    : in out Transformer'Class;
                       Data : in Ada.Streams.Stream_Element_Array) return String;

   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer and return the data in
   --  the Into array, setting Last to the last index.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   procedure Transform (E    : in out Transformer'Class;
                        Data : in String;
                        Into : out Ada.Streams.Stream_Element_Array;
                        Last : out Ada.Streams.Stream_Element_Offset);

   --  Encode the value represented by <tt>Val</tt> in the stream array <tt>Into</tt> starting
   --  at position <tt>Pos</tt> in that array.  The value is encoded using LEB128 format, 7-bits
   --  at a time until all non zero bits are written.  The <tt>Last</tt> parameter is updated
   --  to indicate the position of the last valid byte written in <tt>Into</tt>.
   procedure Encode_LEB128 (Into  : in out Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : in Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset);

   --  Decode from the byte array <tt>From</tt> the value represented as LEB128 format starting
   --  at position <tt>Pos</tt> in that array.  After decoding, the <tt>Last</tt> index is updated
   --  to indicate the last position in the byte array.
   procedure Decode_LEB128 (From  : in Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : out Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset);

private

   type Encoder is new Ada.Finalization.Limited_Controlled with record
      Encode : Transformer_Access := null;
   end record;

   --  Delete the transformers
   overriding
   procedure Finalize (E : in out Encoder);

   type Decoder is new Ada.Finalization.Limited_Controlled with record
      Decode : Transformer_Access := null;
   end record;

   --  Delete the transformers
   overriding
   procedure Finalize (E : in out Decoder);

end Util.Encoders;

-----------------------------------------------------------------------
--  util-encoders -- Encode/Decode streams and strings from one format to another
--  Copyright (C) 2009, 2010, 2011, 2012, 2016, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Streams;
with Ada.Finalization;
with Interfaces;

--  === Encoder and Decoders ===
--  The Util.Encoders package defines the Encoder and Decode objects
--  which provide a mechanism to transform a stream from one format into
--  another format.
--
--  ==== Simple encoding and decoding ====
--
package Util.Encoders is

   pragma Preelaborate;

   Not_Supported  : exception;
   Encoding_Error : exception;

   --  Encoder/decoder for Base64 (RFC 4648)
   BASE_64     : constant String := "base64";

   --  Encoder/decoder for Base64 (RFC 4648) using the URL alphabet
   --  (+ and / are replaced by - and _)
   BASE_64_URL : constant String := "base64url";

   --  Encoder/decoder for Base16 (RFC 4648)
   BASE_16     : constant String := "base16";
   HEX         : constant String := "hex";

   --  Encoder for SHA1 (RFC 3174)
   HASH_SHA1   : constant String := "sha1";

   --  ------------------------------
   --  Encoder context object
   --  ------------------------------
   --  The Encoder provides operations to encode and decode
   --  strings or stream of data from one format to another.
   --  The Encoded contains two Transformer
   --  which either encodes or decodes the stream.
   type Encoder is tagged limited private;

   --  Encodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be encoded.
   --  Raises the Not_Supported exception if the encoding is not
   --  supported.
   function Encode (E    : in Encoder;
                    Data : in String) return String;
   function Encode (E    : in Encoder;
                    Data : in Ada.Streams.Stream_Element_Array) return String;

   --  Create the encoder object for the specified encoding format.
   function Create (Name : in String) return Encoder;

   type Decoder is tagged limited private;

   --  Decodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be decoded.
   --  Raises the Not_Supported exception if the decoding is not
   --  supported.
   function Decode (E    : in Decoder;
                    Data : in String) return String;

   --  Create the decoder object for the specified encoding format.
   function Create (Name : in String) return Decoder;

   --  ------------------------------
   --  Stream Transformation interface
   --  ------------------------------
   --  The Transformer interface defines the operation to transform
   --  a stream from one data format to another.
   type Transformer is limited interface;
   type Transformer_Access is access all Transformer'Class;

   --  Transform the input array represented by Data into
   --  the output array Into.  The transformation made by
   --  the object can be of any nature (Hex encoding, Base64 encoding,
   --  Hex decoding, Base64 decoding, encryption, compression, ...).
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data array.
   --
   --  The transformer returns in Last the last valid position
   --  in the output array Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  array cannot be transformed.
   procedure Transform (E       : in out Transformer;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset) is abstract;

   --  Finish encoding the input array.
   procedure Finish (E    : in out Transformer;
                     Into : in out Ada.Streams.Stream_Element_Array;
                     Last : in out Ada.Streams.Stream_Element_Offset) is null;

   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   function Transform (E    : in out Transformer'Class;
                       Data : in String) return String;

   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   function Transform (E    : in out Transformer'Class;
                       Data : in Ada.Streams.Stream_Element_Array) return String;

   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer and return the data in
   --  the Into array, setting Last to the last index.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   procedure Transform (E    : in out Transformer'Class;
                        Data : in String;
                        Into : out Ada.Streams.Stream_Element_Array;
                        Last : out Ada.Streams.Stream_Element_Offset);

   --  Encode the value represented by <tt>Val</tt> in the stream array <tt>Into</tt> starting
   --  at position <tt>Pos</tt> in that array.  The value is encoded using LEB128 format, 7-bits
   --  at a time until all non zero bits are written.  The <tt>Last</tt> parameter is updated
   --  to indicate the position of the last valid byte written in <tt>Into</tt>.
   procedure Encode_LEB128 (Into  : in out Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : in Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset);

   --  Decode from the byte array <tt>From</tt> the value represented as LEB128 format starting
   --  at position <tt>Pos</tt> in that array.  After decoding, the <tt>Last</tt> index is updated
   --  to indicate the last position in the byte array.
   procedure Decode_LEB128 (From  : in Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : out Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset);

private

   type Encoder is new Ada.Finalization.Limited_Controlled with record
      Encode : Transformer_Access := null;
   end record;

   --  Delete the transformers
   overriding
   procedure Finalize (E : in out Encoder);

   type Decoder is new Ada.Finalization.Limited_Controlled with record
      Decode : Transformer_Access := null;
   end record;

   --  Delete the transformers
   overriding
   procedure Finalize (E : in out Decoder);

end Util.Encoders;

Declare an Encode function that accepts a Stream_Element_Array as parameter


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

with Util.Beans.Basic;
with Util.Beans.Objects;
with Util.Beans.Objects.Maps;

with DOM.Core;
package Gen.Model is

   --  Exception raised if a name is already registered in the model.
   --  This exception is raised if a table, an enum is already defined.
   Name_Exist : exception;

   --  ------------------------------
   --  Model Definition
   --  ------------------------------
   type Definition is new Ada.Finalization.Limited_Controlled
     and Util.Beans.Basic.Readonly_Bean with record
      Row_Index  : Natural;
      Name       : Ada.Strings.Unbounded.Unbounded_String;
      Attrs      : Util.Beans.Objects.Maps.Map_Bean;
      Comment    : Util.Beans.Objects.Object;
   end record;
   type Definition_Access is access all Definition'Class;

   --  Prepare the generation of the model.
   procedure Prepare (O : in out Definition) is null;

   --  Get the object unique name.
   function Get_Name (From : in Definition) return String;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   function Get_Value (From : in Definition;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   function Get_Attribute (From : in Definition;
                           Name : in String) return String;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   function Get_Attribute (From : in Definition;
                           Name : in String) return Ada.Strings.Unbounded.Unbounded_String;

   --  Set the comment associated with the element.
   procedure Set_Comment (Def     : in out Definition;
                          Comment : in String);

   --  Initialize the definition from the DOM node attributes.
   procedure Initialize (Def  : in out Definition;
                         Name : in Ada.Strings.Unbounded.Unbounded_String;
                         Node : in DOM.Core.Node);

end Gen.Model;

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

with Util.Beans.Basic;
with Util.Beans.Objects;
with Util.Beans.Objects.Maps;

with DOM.Core;
package Gen.Model is

   --  Exception raised if a name is already registered in the model.
   --  This exception is raised if a table, an enum is already defined.
   Name_Exist : exception;

   --  ------------------------------
   --  Model Definition
   --  ------------------------------
   type Definition is new Ada.Finalization.Limited_Controlled
     and Util.Beans.Basic.Readonly_Bean with private;
   type Definition_Access is access all Definition'Class;

   --  Prepare the generation of the model.
   procedure Prepare (O : in out Definition) is null;

   --  Get the object unique name.
   function Get_Name (From : in Definition) return String;
   function Name (From : in Definition) return Ada.Strings.Unbounded.Unbounded_String;

   --  Set the object unique name.
   procedure Set_Name (Def  : in out Definition;
                       Name : in String);
   procedure Set_Name (Def  : in out Definition;
                       Name : in Ada.Strings.Unbounded.Unbounded_String);

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   function Get_Value (From : in Definition;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   function Get_Attribute (From : in Definition;
                           Name : in String) return String;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   function Get_Attribute (From : in Definition;
                           Name : in String) return Ada.Strings.Unbounded.Unbounded_String;

   --  Set the comment associated with the element.
   procedure Set_Comment (Def     : in out Definition;
                          Comment : in String);

   --  Get the comment associated with the element.
   function Get_Comment (Def : in Definition) return Util.Beans.Objects.Object;

   --  Set the location (file and line) where the model element is defined in the XMI file.
   procedure Set_Location (Node     : in out Definition;
                           Location : in String);

   --  Get the location file and line where the model element is defined.
   function Get_Location (Node : in Definition) return String;

   --  Initialize the definition from the DOM node attributes.
   procedure Initialize (Def  : in out Definition;
                         Name : in Ada.Strings.Unbounded.Unbounded_String;
                         Node : in DOM.Core.Node);

private

   type Definition is new Ada.Finalization.Limited_Controlled
     and Util.Beans.Basic.Readonly_Bean with record
      Row_Index  : Natural;
      Def_Name   : Ada.Strings.Unbounded.Unbounded_String;
      Attrs      : Util.Beans.Objects.Maps.Map_Bean;
      Comment    : Util.Beans.Objects.Object;
      Location   : Ada.Strings.Unbounded.Unbounded_String;
   end record;

end Gen.Model;

Make the Definition type private Add Set_Name, Get_Comment, Get_Location, Set_Location operations