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

--  This file provides register definitions for the STM32F4 (ARM Cortex M4F)
--  microcontrollers from ST Microelectronics.

with STM32_SVD.EXTI;   use STM32_SVD.EXTI;
with STM32_SVD.SYSCFG; use STM32_SVD.SYSCFG;

with STM32.EXTI;

with STM32.Device;     use STM32.Device;

package body STM32.SYSCFG is

   procedure Connect_External_Interrupt
     (Port : GPIO_Port;
      Pin  : GPIO_Pin_Index)
   is
      CR_Index   : Integer range 0 .. 3;
      EXTI_Index : Integer range EXTI_Field_Array'Range;
      Port_Name  : constant GPIO_Port_Id := As_GPIO_Port_Id (Port);
   begin
      --  First we find the control register, of the four possible, that
      --  contains the EXTI_n value for pin 'n' specified by the Pin parameter.
      --  In effect, this is what we are doing for the EXTICR index:
      --    case GPIO_Pin'Pos (Pin) is
      --       when  0 .. 3  => CR_Index := 0;
      --       when  4 .. 7  => CR_Index := 1;
      --       when  8 .. 11 => CR_Index := 2;
      --       when 12 .. 15 => CR_Index := 3;
      --    end case;
      --  Note that that means we are dependent upon the order of the Pin
      --  declarations because we require GPIO_Pin'Pos(Pin_n) to be 'n', ie
      --  Pin_0 should be at position 0, Pin_1 at position 1, and so forth.
      CR_Index := Pin / 4;

      --  Now we must find which EXTI_n value to use, of the four possible,
      --  within the control register. We are depending on the GPIO_Port type
      --  being an enumeration and that the enumeral order is alphabetical on
      --  the Port letter, such that in effect GPIO_A'Pos = 0, GPIO_B'Pos = 1,
      --  and so on.
      EXTI_Index := GPIO_Port_Id'Pos (Port_Name) mod 4;  -- ie 0 .. 3

      --  Finally we assign the port 'number' to the EXTI_n value within the
      --  control register. We depend upon the Port enumerals' underlying
      --  numeric representation values matching what the hardware expects,
      --  that is, the values 0 .. n-1, which we get automatically unless
      --  overridden.
      case CR_Index is
         when 0 =>
            SYSCFG_Periph.EXTICR1.EXTI.Arr (EXTI_Index) :=
              GPIO_Port_Id'Enum_Rep (Port_Name);
         when 1 =>
            SYSCFG_Periph.EXTICR2.EXTI.Arr (EXTI_Index) :=
              GPIO_Port_Id'Enum_Rep (Port_Name);
         when 2 =>
            SYSCFG_Periph.EXTICR3.EXTI.Arr (EXTI_Index) :=
              GPIO_Port_Id'Enum_Rep (Port_Name);
         when 3 =>
            SYSCFG_Periph.EXTICR4.EXTI.Arr (EXTI_Index) :=
              GPIO_Port_Id'Enum_Rep (Port_Name);
      end case;
   end Connect_External_Interrupt;

     --------------------------------
   -- Connect_External_Interrupt --
   --------------------------------

   procedure Connect_External_Interrupt
     (Port : GPIO_Port;
      Pin  : GPIO_Pin)
   is
   begin
      Connect_External_Interrupt (Port, GPIO_Pin'Pos (Pin));
   end Connect_External_Interrupt;

   --------------------------------
   -- Connect_External_Interrupt --
   --------------------------------

   procedure Connect_External_Interrupt
     (Point  : GPIO_Point)
   is
   begin
      Connect_External_Interrupt (Point.Port.all, Point.Pin);
   end Connect_External_Interrupt;

   --------------------------------
   -- Connect_External_Interrupt --
   --------------------------------

   procedure Connect_External_Interrupt
     (Port : GPIO_Port;
      Pins : GPIO_Pins)
   is
   begin
      for Pin of Pins loop
         Connect_External_Interrupt (Port, Pin);
      end loop;
   end Connect_External_Interrupt;

   ------------------------------
   -- Clear_External_Interrupt --
   ------------------------------

   procedure Clear_External_Interrupt (Pin : GPIO_Pin) is
      use STM32.EXTI;
   begin
      Clear_External_Interrupt (External_Line_Number'Val (GPIO_Pin'Pos (Pin)));
   end Clear_External_Interrupt;

   ------------------------------
   -- Clear_External_Interrupt --
   ------------------------------

   procedure Clear_External_Interrupt (Pin : GPIO_Pin_Index) is
   begin
      EXTI_Periph.PR.PR.Arr (Pin) := 1; --  Set to 1 to clear
   end Clear_External_Interrupt;

end STM32.SYSCFG;

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

--  This file provides register definitions for the STM32F4 (ARM Cortex M4F)
--  microcontrollers from ST Microelectronics.

with STM32_SVD.EXTI;   use STM32_SVD.EXTI;
with STM32_SVD.SYSCFG; use STM32_SVD.SYSCFG;

with STM32.EXTI;

with STM32.Device;     use STM32.Device;

package body STM32.SYSCFG is

   procedure Connect_External_Interrupt
     (Port : GPIO_Port;
      Pin  : GPIO_Pin_Index)
   is
      CR_Index   : Integer range 0 .. 3;
      EXTI_Index : Integer range EXTI_Field_Array'Range;
      Port_Name  : constant GPIO_Port_Id := As_GPIO_Port_Id (Port);
   begin
      --  First we find the control register, of the four possible, that
      --  contains the EXTI_n value for pin 'n' specified by the Pin parameter.
      --  In effect, this is what we are doing for the EXTICR index:
      --    case GPIO_Pin'Pos (Pin) is
      --       when  0 .. 3  => CR_Index := 0;
      --       when  4 .. 7  => CR_Index := 1;
      --       when  8 .. 11 => CR_Index := 2;
      --       when 12 .. 15 => CR_Index := 3;
      --    end case;
      --  Note that that means we are dependent upon the order of the Pin
      --  declarations because we require GPIO_Pin'Pos(Pin_n) to be 'n', ie
      --  Pin_0 should be at position 0, Pin_1 at position 1, and so forth.
      CR_Index := Pin / 4;

      --  Now we must find which EXTI_n value to use, of the four possible,
      --  within the control register. It is set to the actual line to activate
      --  among the 4 accessible by the EXTICR:
      --  EXTICR1: EXTI0 .. EXTI3
      --  EXTICR2: EXTI4 .. EXTI7
      --  EXTICR3: EXTI8 .. EXTI11
      --  EXTICR4: EXTI12 .. EXTI15
      EXTI_Index := Pin mod 4;  -- ie 0 .. 3

      --  Finally we assign the port 'number' to the EXTI_n value within the
      --  control register. We depend upon the Port enumerals' underlying
      --  numeric representation values matching what the hardware expects,
      --  that is, the values 0 .. n-1, which we get automatically unless
      --  overridden.
      case CR_Index is
         when 0 =>
            SYSCFG_Periph.EXTICR1.EXTI.Arr (EXTI_Index) :=
              GPIO_Port_Id'Enum_Rep (Port_Name);
         when 1 =>
            SYSCFG_Periph.EXTICR2.EXTI.Arr (EXTI_Index) :=
              GPIO_Port_Id'Enum_Rep (Port_Name);
         when 2 =>
            SYSCFG_Periph.EXTICR3.EXTI.Arr (EXTI_Index) :=
              GPIO_Port_Id'Enum_Rep (Port_Name);
         when 3 =>
            SYSCFG_Periph.EXTICR4.EXTI.Arr (EXTI_Index) :=
              GPIO_Port_Id'Enum_Rep (Port_Name);
      end case;
   end Connect_External_Interrupt;

     --------------------------------
   -- Connect_External_Interrupt --
   --------------------------------

   procedure Connect_External_Interrupt
     (Port : GPIO_Port;
      Pin  : GPIO_Pin)
   is
   begin
      Connect_External_Interrupt (Port, GPIO_Pin'Pos (Pin));
   end Connect_External_Interrupt;

   --------------------------------
   -- Connect_External_Interrupt --
   --------------------------------

   procedure Connect_External_Interrupt
     (Point  : GPIO_Point)
   is
   begin
      Connect_External_Interrupt (Point.Port.all, Point.Pin);
   end Connect_External_Interrupt;

   --------------------------------
   -- Connect_External_Interrupt --
   --------------------------------

   procedure Connect_External_Interrupt
     (Port : GPIO_Port;
      Pins : GPIO_Pins)
   is
   begin
      for Pin of Pins loop
         Connect_External_Interrupt (Port, Pin);
      end loop;
   end Connect_External_Interrupt;

   ------------------------------
   -- Clear_External_Interrupt --
   ------------------------------

   procedure Clear_External_Interrupt (Pin : GPIO_Pin) is
      use STM32.EXTI;
   begin
      Clear_External_Interrupt (External_Line_Number'Val (GPIO_Pin'Pos (Pin)));
   end Clear_External_Interrupt;

   ------------------------------
   -- Clear_External_Interrupt --
   ------------------------------

   procedure Clear_External_Interrupt (Pin : GPIO_Pin_Index) is
   begin
      EXTI_Periph.PR.PR.Arr (Pin) := 1; --  Set to 1 to clear
   end Clear_External_Interrupt;

end STM32.SYSCFG;

Fix invalid EXTI activation in SYSCFG.

Fix invalid EXTI activation in SYSCFG.


------------------------------------------------------------------------------
-- EMAIL: <darkestkhan@gmail.com>                                           --
-- License: ISC License (see COPYING file)                                  --
--                                                                          --
--                        Copyright © 2015 darkestkhan                      --
------------------------------------------------------------------------------
-- Permission to use, copy, modify, and/or distribute this software for any --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- The software is provided "as is" and the author disclaims all warranties --
-- with regard to this software including all implied warranties of         --
-- merchantability and fitness. In no event shall the author be liable for  --
-- any special, direct, indirect, or consequential damages or any damages   --
-- whatsoever resulting from loss of use, data or profits, whether in an    --
-- action of contract, negligence or other tortious action, arising out of  --
-- or in connection with the use or performance of this software.           --
------------------------------------------------------------------------------
with Ada.Containers.Indefinite_Vectors;

  ------------------------------------------------------------------------------
  -- Small and simple callback based library for processing program arguments --
  ------------------------------------------------------------------------------

  ---------------------------------------------------------------------------
  --                            U  S  A  G  E                              --
  ---------------------------------------------------------------------------
  -- First register all callbacks you are interested in, then call
  -- Process_Arguments.
  --
  -- NOTE: "=" sign can't be part of argument name for registered callback.
  --
  -- Only one callback can be registered per argument, otherwise
  -- Constraint_Error is propagated.
  ---------------------------------------------------------------------------

  ---------------------------------------------------------------------------
  -- Leading single hyphen and double hyphen are stripped (if present) when
  -- processing arguments that are placed before first "--" argument,
  -- so ie. "--help", "-help" and "help" are functionally
  -- equivalent, treated as if "help" was actually passed in all 3 cases.
  -- (you should register callback just for "help", if you register it for
  -- "--help" then actually passed argument would have to be "----help" in order
  -- for it to trigger said callback)
  --
  -- In addition if you registered callback as case insensitive, then
  -- (using above example) "Help", "HELP", "help" and "HeLp" all would result in
  -- call to said callback.
  --
  -- If Argument_Type is Variable then callback will receive part of argument
  -- that is after "=" sign. (ie. "OS=Linux" argument would result in callback
  -- receiving only "Linux" as its argument), otherwise actual argument will be
  -- passed.
  --
  -- For Variable, case insensitive callbacks simple rule applies:
  -- only variable name is case insensitive, with actual value (when passed to
  -- program) being unchanged.
  --
  -- If argument for which callback is registered is passed few times
  -- (ie. ./program help help help) then callback is triggered however many
  -- times said argument is detected.
  --
  -- All arguments with no associated callback are added to Unknown_Arguments
  --  vector as long as they appear before first "--" argument.
  --
  -- All arguments after first "--" (standalone double hyphen) are added to
  --  Input_Argument vector (this includes another "--"), w/o any kind of
  --  hyphen stripping being performed on them.
  --
  -- NOTE: No care is taken to ensure that all Input_Arguments
  --  (or Unknown_Arguments) are unique.
  ---------------------------------------------------------------------------

package CBAP is

  ---------------------------------------------------------------------------
  -- Yes, I do realize this is actually vector...
  package Argument_Lists is new
    Ada.Containers.Indefinite_Vectors (Positive, String);

  -- List of all arguments (before first "--" argument) for which callbacks
  --  where not registered.
  Unknown_Arguments : Argument_Lists.Vector := Argument_Lists.Empty_Vector;
  -- List of all arguments after first "--" argument.
  Input_Arguments   : Argument_Lists.Vector := Argument_Lists.Empty_Vector;

  -- Argument_Types decides if argument is just a simple value, or a variable
  -- with value assigned to it (difference between "--val" and "--var=val")
  type Argument_Types is (Value, Variable);

  -- Argument is useful mostly for Variable type of arguments.
  type Callbacks is not null access procedure (Argument: in String);

  ---------------------------------------------------------------------------
  -- Register callbacks for processing arguments.
  -- @Callback      : Action to be performed in case appropriate argument is
  --    detected.
  -- @Called_On     : Argument for which callback is to be performed.
  -- @Argument_Type : {Value, Variable}. Value is simple argument that needs no
  --    additional parsing. Variable is argument of "Arg_Name=Some_Val" form.
  --    When callback is triggered, Value is passed to callback as input, in
  --    case of Variable it is content of argument after first "=" that is
  --    passed to callback.
  -- @Case_Sensitive: Whether or not case is significant. When False all forms
  --    of argument are treated as if written in lower case.
  procedure Register
    ( Callback      : in Callbacks;
      Called_On     : in String;
      Argument_Type : in Argument_Types := Value;
      Case_Sensitive: in Boolean        := True
    );

  -- Raised if Called_On contains "=".
  Incorrect_Called_On: exception;

  ---------------------------------------------------------------------------
  -- Parse arguments supplied to program, calling callbacks when argument with
  -- associated callback is detected.
  -- NOTE: Process_Arguments will call callbacks however many times argument
  --  with associated callback is called. So if you have callback for "help",
  --  then ./program help help help
  --  will result in 3 calls to said callback.
  procedure Process_Arguments;

  ---------------------------------------------------------------------------

end CBAP;

------------------------------------------------------------------------------
-- EMAIL: <darkestkhan@gmail.com>                                           --
-- License: ISC License (see COPYING file)                                  --
--                                                                          --
--                        Copyright © 2015 darkestkhan                      --
------------------------------------------------------------------------------
-- Permission to use, copy, modify, and/or distribute this software for any --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- The software is provided "as is" and the author disclaims all warranties --
-- with regard to this software including all implied warranties of         --
-- merchantability and fitness. In no event shall the author be liable for  --
-- any special, direct, indirect, or consequential damages or any damages   --
-- whatsoever resulting from loss of use, data or profits, whether in an    --
-- action of contract, negligence or other tortious action, arising out of  --
-- or in connection with the use or performance of this software.           --
------------------------------------------------------------------------------
with Ada.Containers.Indefinite_Vectors;

  ------------------------------------------------------------------------------
  -- Small and simple callback based library for processing program arguments --
  ------------------------------------------------------------------------------

  ---------------------------------------------------------------------------
  --                            U  S  A  G  E                              --
  ---------------------------------------------------------------------------
  -- First register all callbacks you are interested in, then call
  -- Process_Arguments.
  --
  -- NOTE: "=" sign can't be part of argument name for registered callback.
  --
  -- Only one callback can be registered per argument, otherwise
  -- Constraint_Error is propagated.
  ---------------------------------------------------------------------------

  ---------------------------------------------------------------------------
  -- Leading single hyphen and double hyphen are stripped (if present) when
  -- processing arguments that are placed before first "--" argument,
  -- so e.g. "--help", "-help" and "help" are functionally
  -- equivalent, treated as if "help" was actually passed in all 3 cases.
  -- (you should register callback just for "help", if you register it for
  -- "--help" then actually passed argument would have to be "----help" in order
  -- for it to trigger said callback)
  --
  -- In addition if you registered callback as case insensitive, then
  -- (using above example) "Help", "HELP", "help" and "HeLp" all would result in
  -- call to said callback.
  --
  -- If Argument_Type is Variable then callback will receive part of argument
  -- that is after "=" sign. (ie. "OS=Linux" argument would result in callback
  -- receiving only "Linux" as its argument), otherwise actual argument will be
  -- passed.
  --
  -- For Variable, case insensitive callbacks simple rule applies:
  -- only variable name is case insensitive, with actual value (when passed to
  -- program) being unchanged.
  --
  -- If argument for which callback is registered is passed few times
  -- (ie. ./program help help help) then callback is triggered however many
  -- times said argument is detected.
  --
  -- NOTE that Check for case insensitive callback is being performed first,
  --  thus if you happen to register callback for "help" (case insensitive) and
  --  "HeLp" (case sensitive) then only the case insensitive one will be called
  --  (i.e. "help").
  --
  -- All arguments with no associated callback are added to Unknown_Arguments
  --  vector as long as they appear before first "--" argument.
  --
  -- All arguments after first "--" (standalone double hyphen) are added to
  --  Input_Argument vector (this includes another "--"), w/o any kind of
  --  hyphen stripping being performed on them.
  --
  -- NOTE: No care is taken to ensure that all Input_Arguments
  --  (or Unknown_Arguments) are unique.
  ---------------------------------------------------------------------------

package CBAP is

  ---------------------------------------------------------------------------
  -- Yes, I do realize this is actually vector...
  package Argument_Lists is new
    Ada.Containers.Indefinite_Vectors (Positive, String);

  -- List of all arguments (before first "--" argument) for which callbacks
  --  where not registered.
  Unknown_Arguments : Argument_Lists.Vector := Argument_Lists.Empty_Vector;
  -- List of all arguments after first "--" argument.
  Input_Arguments   : Argument_Lists.Vector := Argument_Lists.Empty_Vector;

  -- Argument_Types decides if argument is just a simple value, or a variable
  -- with value assigned to it (difference between "--val" and "--var=val")
  type Argument_Types is (Value, Variable);

  -- Argument is useful mostly for Variable type of arguments.
  type Callbacks is not null access procedure (Argument: in String);

  ---------------------------------------------------------------------------
  -- Register callbacks for processing arguments.
  -- @Callback      : Action to be performed in case appropriate argument is
  --    detected.
  -- @Called_On     : Argument for which callback is to be performed.
  -- @Argument_Type : {Value, Variable}. Value is simple argument that needs no
  --    additional parsing. Variable is argument of "Arg_Name=Some_Val" form.
  --    When callback is triggered, Value is passed to callback as input, in
  --    case of Variable it is content of argument after first "=" that is
  --    passed to callback.
  -- @Case_Sensitive: Whether or not case is significant. When False all forms
  --    of argument are treated as if written in lower case.
  procedure Register
    ( Callback      : in Callbacks;
      Called_On     : in String;
      Argument_Type : in Argument_Types := Value;
      Case_Sensitive: in Boolean        := True
    );

  -- Raised if Called_On contains "=".
  Incorrect_Called_On: exception;

  ---------------------------------------------------------------------------
  -- Parse arguments supplied to program, calling callbacks when argument with
  -- associated callback is detected.
  -- NOTE: Process_Arguments will call callbacks however many times argument
  --  with associated callback is called. So if you have callback for "help",
  --  then ./program help help help
  --  will result in 3 calls to said callback.
  procedure Process_Arguments;

  ---------------------------------------------------------------------------

end CBAP;

Expand comment about edge case.

Expand comment about edge case.

Signed-off-by: darkestkhan <e9a7a7cf2a6af79e93742343a7a5cac5d90f9bd2@gmail.com>


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

with Util.Strings;
with Util.Events;
with Util.Beans.Objects;
with Util.Beans.Basic;

with ASF.Applications;

--  == Introduction ==
--  The AWA.Events package defines an event framework for modules to post events
--  and have Ada bean methods be invoked when these events are dispatched.  Subscription to
--  events is done through configuration files.  This allows to configure the modules and
--  integrate them together easily at configuration time.
--
--  1/ Modules define the events that they can generate by instantiating the Definition
--     package. This is a static definition of the event.  Each event is given a unique name.
--
--    package Event_New_User is new AWA.Events.Definition ("new-user");
--
--  2/ The module can post an event to inform other modules or the system that a particular
--     action occurred.  The module creates the event instance of type Module_Event and
--     populates that event with useful properties for event receivers.
--
--      Event : AWA.Events.Module_Event;
--
--      Event.Set_Event_Kind (Event_New_User.Kind);
--      Event.Set_Parameter ("email", "harry.potter@hogwarts.org");
--
--  3/ The module will post the event by using the Send_Event operation.
--
--    Manager.Send_Event (Event);
--
--  4/ Modules or applications interested by a particular event will configure the event manager
--     to dispatch the event to an Ada bean event action.  The Ada bean is an object that must
--     implement a procedure that matches the prototype:
--
--        type Action_Bean is new Util.Beans.Basic.Readonly_Bean ...;
--        procedure Action (Bean : in out Action_Bean; Event : in AWA.Events.Module_Event'Class);
--
--     The Ada bean method and object are registered as other Ada beans.
--
--  5/ The configuration file indicates how to bind the Ada bean action and the event together.
--     The action is specified using an EL Method Expression (See Ada EL or JSR 245).
--
--       <on-event name="new_user">
--           <action>#{ada_bean.action}</action>
--       </on-event>
--
--  == Data Model ==
--  @include Queues.hbm.xml
--
package AWA.Events is

   type Queue_Index is new Natural;
   type Event_Index is new Natural;

   --  ------------------------------
   --  Event kind definition
   --  ------------------------------
   --  This package must be instantiated for each event that a module can post.
   generic
      Name : String;
   package Definition is
      function Kind return Event_Index;
      pragma Inline_Always (Kind);
   end Definition;

   --  Exception raised if an event name is not found.
   Not_Found : exception;

   --  Identifies an invalid event.
   Invalid_Event : constant Event_Index := 0;

   --  Find the event runtime index given the event name.
   --  Raises Not_Found exception if the event name is not recognized.
   function Find_Event_Index (Name : in String) return Event_Index;

   --  ------------------------------
   --  Module event
   --  ------------------------------
   type Module_Event is new Util.Events.Event and Util.Beans.Basic.Readonly_Bean with private;
   type Module_Event_Access is access all Module_Event'Class;

   --  Set the event type which identifies the event.
   procedure Set_Event_Kind (Event : in out Module_Event;
                             Kind  : in Event_Index);

   --  Get the event type which identifies the event.
   function Get_Event_Kind (Event : in Module_Event) return Event_Index;

   --  Set a parameter on the message.
   procedure Set_Parameter (Event  : in out Module_Event;
                            Name   : in String;
                            Value  : in String);

   --  Get the parameter with the given name.
   function Get_Parameter (Event : in Module_Event;
                           Name  : in String) return String;

   --  Get the value that corresponds to the parameter with the given name.
   overriding
   function Get_Value (Event : in Module_Event;
                       Name  : in String) return Util.Beans.Objects.Object;

private

   type Module_Event is new Util.Events.Event and Util.Beans.Basic.Readonly_Bean with record
      Kind  : Event_Index := Invalid_Event;
      Props : ASF.Applications.Config;
   end record;

   --  The index of the last event definition.
   Last_Event : Event_Index := 0;

   --  Get the event type name.
   function Get_Event_Type_Name (Index : in Event_Index) return Util.Strings.Name_Access;

   --  Make and return a copy of the event.
   function Copy (Event : in Module_Event) return Module_Event_Access;

end AWA.Events;

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

with Util.Strings;
with Util.Events;
with Util.Beans.Objects;
with Util.Beans.Basic;

with ASF.Applications;

--  == Introduction ==
--  The AWA.Events package defines an event framework for modules to post events
--  and have Ada bean methods be invoked when these events are dispatched.  Subscription to
--  events is done through configuration files.  This allows to configure the modules and
--  integrate them together easily at configuration time.
--
--  Modules define the events that they can generate by instantiating the Definition
--  package. This is a static definition of the event.  Each event is given a unique name.
--
--    package Event_New_User is new AWA.Events.Definition ("new-user");
--
--  The module can post an event to inform other modules or the system that a particular
--  action occurred.  The module creates the event instance of type Module_Event and
--  populates that event with useful properties for event receivers.
--
--      Event : AWA.Events.Module_Event;
--
--      Event.Set_Event_Kind (Event_New_User.Kind);
--      Event.Set_Parameter ("email", "harry.potter@hogwarts.org");
--
--  The module will post the event by using the Send_Event operation.
--
--    Manager.Send_Event (Event);
--
--  Modules or applications interested by a particular event will configure the event manager
--  to dispatch the event to an Ada bean event action.  The Ada bean is an object that must
--  implement a procedure that matches the prototype:
--
--        type Action_Bean is new Util.Beans.Basic.Readonly_Bean ...;
--        procedure Action (Bean : in out Action_Bean; Event : in AWA.Events.Module_Event'Class);
--
--  The Ada bean method and object are registered as other Ada beans.
--
--  The configuration file indicates how to bind the Ada bean action and the event together.
--  The action is specified using an EL Method Expression (See Ada EL or JSR 245).
--
--       <on-event name="new_user">
--           <action>#{ada_bean.action}</action>
--       </on-event>
--
--  == Data Model ==
--  @include Queues.hbm.xml
--
package AWA.Events is

   type Queue_Index is new Natural;
   type Event_Index is new Natural;

   --  ------------------------------
   --  Event kind definition
   --  ------------------------------
   --  This package must be instantiated for each event that a module can post.
   generic
      Name : String;
   package Definition is
      function Kind return Event_Index;
      pragma Inline_Always (Kind);
   end Definition;

   --  Exception raised if an event name is not found.
   Not_Found : exception;

   --  Identifies an invalid event.
   Invalid_Event : constant Event_Index := 0;

   --  Find the event runtime index given the event name.
   --  Raises Not_Found exception if the event name is not recognized.
   function Find_Event_Index (Name : in String) return Event_Index;

   --  ------------------------------
   --  Module event
   --  ------------------------------
   type Module_Event is new Util.Events.Event and Util.Beans.Basic.Readonly_Bean with private;
   type Module_Event_Access is access all Module_Event'Class;

   --  Set the event type which identifies the event.
   procedure Set_Event_Kind (Event : in out Module_Event;
                             Kind  : in Event_Index);

   --  Get the event type which identifies the event.
   function Get_Event_Kind (Event : in Module_Event) return Event_Index;

   --  Set a parameter on the message.
   procedure Set_Parameter (Event  : in out Module_Event;
                            Name   : in String;
                            Value  : in String);

   --  Get the parameter with the given name.
   function Get_Parameter (Event : in Module_Event;
                           Name  : in String) return String;

   --  Get the value that corresponds to the parameter with the given name.
   overriding
   function Get_Value (Event : in Module_Event;
                       Name  : in String) return Util.Beans.Objects.Object;

private

   type Module_Event is new Util.Events.Event and Util.Beans.Basic.Readonly_Bean with record
      Kind  : Event_Index := Invalid_Event;
      Props : ASF.Applications.Config;
   end record;

   --  The index of the last event definition.
   Last_Event : Event_Index := 0;

   --  Get the event type name.
   function Get_Event_Type_Name (Index : in Event_Index) return Util.Strings.Name_Access;

   --  Make and return a copy of the event.
   function Copy (Event : in Module_Event) return Module_Event_Access;

end AWA.Events;

Update the documentation

Update the documentation


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

with Util.Beans.Objects;
with Util.Beans.Basic;
with Util.Beans.Methods;

with AWA.Events;
with AWA.Jobs.Services;
with AWA.Jobs.Modules;
package AWA.Jobs.Beans is

   --  The <tt>Process_Bean</tt> is the Ada bean that receives the job event and
   --  performs the job action associated with it.
   type Process_Bean is limited new Util.Beans.Basic.Bean
     and Util.Beans.Methods.Method_Bean with private;
   type Process_Bean_Access is access all Process_Bean'Class;

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

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

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

   --  Execute the job described by the event.
   procedure Execute (Bean    : in out Process_Bean;
                      Event   : in AWA.Events.Module_Event'Class);

   --  Create the job process bean instance.
   function Create_Process_Bean (Module : in AWA.Jobs.Modules.Job_Module_Access)
                                 return Util.Beans.Basic.Readonly_Bean_Access;

private

   type Process_Bean is limited new Util.Beans.Basic.Bean
     and Util.Beans.Methods.Method_Bean with record
      Module : AWA.Jobs.Modules.Job_Module_Access;
      Job    : AWA.Jobs.Services.Job_Ref;
   end record;

end AWA.Jobs.Beans;

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

with Util.Beans.Objects;
with Util.Beans.Basic;
with Util.Beans.Methods;

with AWA.Events;
with AWA.Jobs.Services;
with AWA.Jobs.Modules;
package AWA.Jobs.Beans is

   --  The <tt>Process_Bean</tt> is the Ada bean that receives the job event and
   --  performs the job action associated with it.
   type Process_Bean is limited new Util.Beans.Basic.Bean
     and Util.Beans.Methods.Method_Bean with private;
   type Process_Bean_Access is access all Process_Bean'Class;

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

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

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

   --  Execute the job described by the event.
   procedure Execute (Bean    : in out Process_Bean;
                      Event   : in AWA.Events.Module_Event'Class);

   --  Create the job process bean instance.
   function Create_Process_Bean (Module : in AWA.Jobs.Modules.Job_Module_Access)
                                 return Util.Beans.Basic.Readonly_Bean_Access;

private

   type Process_Bean is limited new Util.Beans.Basic.Bean
     and Util.Beans.Methods.Method_Bean with record
      Module : AWA.Jobs.Modules.Job_Module_Access;
      Job    : AWA.Jobs.Services.Job_Ref;
   end record;

end AWA.Jobs.Beans;

Update copyright year

Update copyright year


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

--  This file provides declarations for devices on the STM32F469 Discovery kits
--  manufactured by ST Microelectronics.

with STM32.Device;  use STM32.Device;

with STM32.GPIO;    use STM32.GPIO;
with STM32.FMC;     use STM32.FMC;

with Ada.Interrupts.Names;  use Ada.Interrupts;

use STM32;  -- for base addresses
--  with STM32.I2C; use STM32.I2C;

with Framebuffer_OTM8009A;
with Touch_Panel_FT6x06;

package STM32.Board is

   pragma Elaborate_Body;

   subtype User_LED is GPIO_Point;

   Green     : User_LED renames LED1;
   Orange    : User_LED renames LED2;
   Red       : User_LED renames LED3;
   Blue      : User_LED renames LED4;

   LCH_LED   : User_LED renames Red;

   All_LEDs  : GPIO_Points := Green & Orange & Red & Blue;

   procedure Initialize_LEDs;
   --  MUST be called prior to any use of the LEDs

   procedure Turn_On (This : in out User_LED)
     renames STM32.GPIO.Clear;
   procedure Turn_Off (This : in out User_LED)
     renames STM32.GPIO.Set;

   procedure All_LEDs_Off with Inline;
   procedure All_LEDs_On  with Inline;
   procedure Toggle_LEDs (These : in out GPIO_Points)
     renames STM32.GPIO.Toggle;

--     Gyro : Three_Axis_Gyroscope;

   --  GPIO Pins for FMC

   FMC_D : constant GPIO_Points :=
             (PD0, PD1, PD8, PD9, PD10, PD14, PD15,
              PE7, PE8, PE9, PE10, PE11, PE12, PE13, PE14, PE15,
              PH8, PH9, PH10, PH11, PH12, PH13, PH14, PH15,
              PI0, PI1, PI2, PI3, PI6, PI7, PI9, PI10);

   FMC_A : constant GPIO_Points :=
              (PF0, PF1, PF2, PF3, PF4, PF5,
               PF12, PF13, PF14, PF15, PG0, PG1, PG4, PG5);

   FMC_SDNWE  : GPIO_Point renames PC0;
   FMC_SDNRAS : GPIO_Point renames PF11;
   FMC_SDNCAS : GPIO_Point renames PG15;
   FMC_SDNE0  : GPIO_Point renames PH3;
   FMC_SDCKE0 : GPIO_Point renames PH2;
   FMC_SDCLK  : GPIO_Point renames PG8;

   FMC_NBL0   : GPIO_Point renames PE0;
   FMC_NBL1   : GPIO_Point renames PE1;
   FMC_NBL2   : GPIO_Point renames PI4;
   FMC_NBL3   : GPIO_Point renames PI5;

   SDRAM_PINS    : constant GPIO_Points :=
                     FMC_A & FMC_D &
                     FMC_SDNWE & FMC_SDNRAS & FMC_SDNCAS & FMC_SDCLK &
                     FMC_SDNE0 & FMC_SDCKE0 & FMC_NBL0 & FMC_NBL1 &
                     FMC_NBL2 & FMC_NBL3;

   --  SDRAM CONFIGURATION Parameters
   SDRAM_Base         : constant := 16#C0000000#;
   SDRAM_Size         : constant := 16#800000#;
   SDRAM_Bank         : constant STM32.FMC.FMC_SDRAM_Cmd_Target_Bank :=
                          STM32.FMC.FMC_Bank1_SDRAM;
   SDRAM_Mem_Width    : constant STM32.FMC.FMC_SDRAM_Memory_Bus_Width :=
                          STM32.FMC.FMC_SDMemory_Width_32b;
   SDRAM_Row_Bits     : constant STM32.FMC.FMC_SDRAM_Row_Address_Bits :=
                          FMC_RowBits_Number_11b;
   SDRAM_CAS_Latency  : constant STM32.FMC.FMC_SDRAM_CAS_Latency :=
                          STM32.FMC.FMC_CAS_Latency_3;
   SDRAM_CLOCK_Period : constant STM32.FMC.FMC_SDRAM_Clock_Configuration :=
                          STM32.FMC.FMC_SDClock_Period_2;
   SDRAM_Read_Burst   : constant STM32.FMC.FMC_SDRAM_Burst_Read :=
                          STM32.FMC.FMC_Read_Burst_Single;
   SDRAM_Read_Pipe    : constant STM32.FMC.FMC_SDRAM_Read_Pipe_Delay :=
                          STM32.FMC.FMC_ReadPipe_Delay_0;
   SDRAM_Refresh_Cnt  : constant := 16#0569#;

   ---------------
   -- SPI5 Pins --
   ---------------

--     SPI5_SCK     : GPIO_Point renames PF7;
--     SPI5_MISO    : GPIO_Point renames PF8;
--     SPI5_MOSI    : GPIO_Point renames PF9;
--     NCS_MEMS_SPI : GPIO_Point renames PC1;
--     MEMS_INT1    : GPIO_Point renames PA1;
--     MEMS_INT2    : GPIO_Point renames PA2;
--     LCD_SPI      : SPI_Port   renames SPI_5;

   --------------------------------
   -- Screen/Touch panel devices --
   --------------------------------

   LCD_Natural_Width  : constant := Framebuffer_OTM8009A.LCD_Natural_Width;
   LCD_Natural_Height : constant := Framebuffer_OTM8009A.LCD_Natural_Height;
   Display            : Framebuffer_OTM8009A.Frame_Buffer;
   Touch_Panel        : Touch_Panel_FT6x06.Touch_Panel;

   -----------------
   -- Touch Panel --
   -----------------

   I2C1_SCL : GPIO_Point renames PB8;
   I2C1_SDA : GPIO_Point renames PB9;

   TP_INT   : GPIO_Point renames PJ5;

   TP_Pins  : constant GPIO_Points :=
                (I2C1_SCL, I2C1_SDA);

   --  User button

   User_Button_Point     : GPIO_Point renames PA0;
   User_Button_Interrupt : constant Interrupt_ID := Names.EXTI0_Interrupt;

   procedure Configure_User_Button_GPIO;
   --  Configures the GPIO port/pin for the blue user button. Sufficient
   --  for polling the button, and necessary for having the button generate
   --  interrupts.

end STM32.Board;

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

--  This file provides declarations for devices on the STM32F469 Discovery kits
--  manufactured by ST Microelectronics.

with STM32.Device;  use STM32.Device;

with STM32.GPIO;    use STM32.GPIO;
with STM32.FMC;     use STM32.FMC;

with Ada.Interrupts.Names;  use Ada.Interrupts;

use STM32;  -- for base addresses
--  with STM32.I2C; use STM32.I2C;

with Framebuffer_OTM8009A;
with Touch_Panel_FT6x06;

package STM32.Board is

   pragma Elaborate_Body;

   subtype User_LED is GPIO_Point;

   Green     : User_LED renames PG6;
   Orange    : User_LED renames PD4;
   Red       : User_LED renames PD5;
   Blue      : User_LED renames PK3;

   LCH_LED   : User_LED renames Red;

   All_LEDs  : GPIO_Points := Green & Orange & Red & Blue;

   procedure Initialize_LEDs;
   --  MUST be called prior to any use of the LEDs

   procedure Turn_On (This : in out User_LED)
     renames STM32.GPIO.Clear;
   procedure Turn_Off (This : in out User_LED)
     renames STM32.GPIO.Set;

   procedure All_LEDs_Off with Inline;
   procedure All_LEDs_On  with Inline;
   procedure Toggle_LEDs (These : in out GPIO_Points)
     renames STM32.GPIO.Toggle;

--     Gyro : Three_Axis_Gyroscope;

   --  GPIO Pins for FMC

   FMC_D : constant GPIO_Points :=
             (PD0, PD1, PD8, PD9, PD10, PD14, PD15,
              PE7, PE8, PE9, PE10, PE11, PE12, PE13, PE14, PE15,
              PH8, PH9, PH10, PH11, PH12, PH13, PH14, PH15,
              PI0, PI1, PI2, PI3, PI6, PI7, PI9, PI10);

   FMC_A : constant GPIO_Points :=
              (PF0, PF1, PF2, PF3, PF4, PF5,
               PF12, PF13, PF14, PF15, PG0, PG1, PG4, PG5);

   FMC_SDNWE  : GPIO_Point renames PC0;
   FMC_SDNRAS : GPIO_Point renames PF11;
   FMC_SDNCAS : GPIO_Point renames PG15;
   FMC_SDNE0  : GPIO_Point renames PH3;
   FMC_SDCKE0 : GPIO_Point renames PH2;
   FMC_SDCLK  : GPIO_Point renames PG8;

   FMC_NBL0   : GPIO_Point renames PE0;
   FMC_NBL1   : GPIO_Point renames PE1;
   FMC_NBL2   : GPIO_Point renames PI4;
   FMC_NBL3   : GPIO_Point renames PI5;

   SDRAM_PINS    : constant GPIO_Points :=
                     FMC_A & FMC_D &
                     FMC_SDNWE & FMC_SDNRAS & FMC_SDNCAS & FMC_SDCLK &
                     FMC_SDNE0 & FMC_SDCKE0 & FMC_NBL0 & FMC_NBL1 &
                     FMC_NBL2 & FMC_NBL3;

   --  SDRAM CONFIGURATION Parameters
   SDRAM_Base         : constant := 16#C0000000#;
   SDRAM_Size         : constant := 16#800000#;
   SDRAM_Bank         : constant STM32.FMC.FMC_SDRAM_Cmd_Target_Bank :=
                          STM32.FMC.FMC_Bank1_SDRAM;
   SDRAM_Mem_Width    : constant STM32.FMC.FMC_SDRAM_Memory_Bus_Width :=
                          STM32.FMC.FMC_SDMemory_Width_32b;
   SDRAM_Row_Bits     : constant STM32.FMC.FMC_SDRAM_Row_Address_Bits :=
                          FMC_RowBits_Number_11b;
   SDRAM_CAS_Latency  : constant STM32.FMC.FMC_SDRAM_CAS_Latency :=
                          STM32.FMC.FMC_CAS_Latency_3;
   SDRAM_CLOCK_Period : constant STM32.FMC.FMC_SDRAM_Clock_Configuration :=
                          STM32.FMC.FMC_SDClock_Period_2;
   SDRAM_Read_Burst   : constant STM32.FMC.FMC_SDRAM_Burst_Read :=
                          STM32.FMC.FMC_Read_Burst_Single;
   SDRAM_Read_Pipe    : constant STM32.FMC.FMC_SDRAM_Read_Pipe_Delay :=
                          STM32.FMC.FMC_ReadPipe_Delay_0;
   SDRAM_Refresh_Cnt  : constant := 16#0569#;

   ---------------
   -- SPI5 Pins --
   ---------------

--     SPI5_SCK     : GPIO_Point renames PF7;
--     SPI5_MISO    : GPIO_Point renames PF8;
--     SPI5_MOSI    : GPIO_Point renames PF9;
--     NCS_MEMS_SPI : GPIO_Point renames PC1;
--     MEMS_INT1    : GPIO_Point renames PA1;
--     MEMS_INT2    : GPIO_Point renames PA2;
--     LCD_SPI      : SPI_Port   renames SPI_5;

   --------------------------------
   -- Screen/Touch panel devices --
   --------------------------------

   LCD_Natural_Width  : constant := Framebuffer_OTM8009A.LCD_Natural_Width;
   LCD_Natural_Height : constant := Framebuffer_OTM8009A.LCD_Natural_Height;
   Display            : Framebuffer_OTM8009A.Frame_Buffer;
   Touch_Panel        : Touch_Panel_FT6x06.Touch_Panel;

   -----------------
   -- Touch Panel --
   -----------------

   I2C1_SCL : GPIO_Point renames PB8;
   I2C1_SDA : GPIO_Point renames PB9;

   TP_INT   : GPIO_Point renames PJ5;

   TP_Pins  : constant GPIO_Points :=
                (I2C1_SCL, I2C1_SDA);

   --  User button

   User_Button_Point     : GPIO_Point renames PA0;
   User_Button_Interrupt : constant Interrupt_ID := Names.EXTI0_Interrupt;

   procedure Configure_User_Button_GPIO;
   --  Configures the GPIO port/pin for the blue user button. Sufficient
   --  for polling the button, and necessary for having the button generate
   --  interrupts.

end STM32.Board;

Fix the LED decls

Fix the LED decls


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

with Util.Serialize.IO;
with Util.Http.Clients;
with Util.Serialize.Mappers.Record_Mapper;

--  The Util.Http.Rest package defines a REST client type which helps in writing
--  REST client APIs.  A REST client is similar to an HTTP client but it provides additional
--  operations that are useful in REST APIs.
package Util.Http.Rest is

   --  -----------------------
   --  REST client
   --  -----------------------
   type Client is new Util.Http.Clients.Client with private;

   --  Execute an HTTP GET operation using the Http client on the given URI.
   --  Upon successful reception of the response, parse the JSON result and populate the
   --  serialization context associated with the parser.
   procedure Get (Http   : in out Client;
                  URI    : in String;
                  Parser : in out Util.Serialize.IO.Parser'Class);

   --  Execute an HTTP GET operation on the given URI and parse the JSON response
   --  into the target object refered to by Into by using the mapping described
   --  in Mapping.
   generic
      --  Package that maps the element into a record.
      with package Element_Mapper is
        new Util.Serialize.Mappers.Record_Mapper (<>);
   procedure Rest_Get (URI     : in String;
                       Mapping : in Util.Serialize.Mappers.Mapper_Access;
                       Path    : in String := "";
                       Into    : in Element_Mapper.Element_Type_Access);

private

   type Client is new Util.Http.Clients.Client with record
      Status : Natural := 0;
   end record;

end Util.Http.Rest;

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

with Util.Serialize.IO;
with Util.Http.Clients;
with Util.Serialize.Mappers.Record_Mapper;

--  The Util.Http.Rest package defines a REST client type which helps in writing
--  REST client APIs.  A REST client is similar to an HTTP client but it provides additional
--  operations that are useful in REST APIs.
package Util.Http.Rest is

   --  -----------------------
   --  REST client
   --  -----------------------
   type Client is new Util.Http.Clients.Client with private;

   --  Execute an HTTP GET operation using the Http client on the given URI.
   --  Upon successful reception of the response, parse the JSON result and populate the
   --  serialization context associated with the parser.
   procedure Get (Http   : in out Client;
                  URI    : in String;
                  Parser : in out Util.Serialize.IO.Parser'Class;
                  Sink   : in out Util.Serialize.IO.Reader'Class);

   --  Execute an HTTP GET operation on the given URI and parse the JSON response
   --  into the target object refered to by Into by using the mapping described
   --  in Mapping.
   generic
      --  Package that maps the element into a record.
      with package Element_Mapper is
        new Util.Serialize.Mappers.Record_Mapper (<>);
   procedure Rest_Get (URI     : in String;
                       Mapping : in Util.Serialize.Mappers.Mapper_Access;
                       Path    : in String := "";
                       Into    : in Element_Mapper.Element_Type_Access);

private

   type Client is new Util.Http.Clients.Client with record
      Status : Natural := 0;
   end record;

end Util.Http.Rest;

Add a Reader class parameter to the Get procedure


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

package body GL.Loader is

   pragma Linker_Options ("-lkernel32", "-lopengl32");

   function Get_Proc_Address (Name : Interfaces.C.char_array) return System.Address is
      use type System.Address;

      function WGL_Get_Proc_Address
        (Name : Interfaces.C.char_array) return System.Address
      with Import, Convention => StdCall, External_Name => "wglGetProcAddress";

      function Old_Get_Proc_Address
        (Handle : System.Address;
         Name   : Interfaces.C.char_array) return System.Address
      with Import, Convention => StdCall, External_Name => "GetProcAddress";

      function Get_Module_Handle
        (Name : Interfaces.C.char_array) return System.Address
      with Import, Convention => StdCall, External_Name => "GetModuleHandleA";

      Result : constant System.Address := WGL_Get_Proc_Address (Name);
   begin
      if Result /= System.Null_Address then
         return Result;
      else
         --  OpenGL 1.1 functions are directly exported in the opengl32 library
         return Old_Get_Proc_Address (Get_Module_Handle ("opengl32"), Name);
      end if;
   end Get_Proc_Address;

end GL.Loader;

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

package body GL.Loader is

   pragma Linker_Options ("-lkernel32 -lopengl32");

   function Get_Proc_Address (Name : Interfaces.C.char_array) return System.Address is
      use type System.Address;

      function WGL_Get_Proc_Address
        (Name : Interfaces.C.char_array) return System.Address
      with Import, Convention => StdCall, External_Name => "wglGetProcAddress";

      function Old_Get_Proc_Address
        (Handle : System.Address;
         Name   : Interfaces.C.char_array) return System.Address
      with Import, Convention => StdCall, External_Name => "GetProcAddress";

      function Get_Module_Handle
        (Name : Interfaces.C.char_array) return System.Address
      with Import, Convention => StdCall, External_Name => "GetModuleHandleA";

      Result : constant System.Address := WGL_Get_Proc_Address (Name);
   begin
      if Result /= System.Null_Address then
         return Result;
      else
         --  OpenGL 1.1 functions are directly exported in the opengl32 library
         return Old_Get_Proc_Address (Get_Module_Handle ("opengl32"), Name);
      end if;
   end Get_Proc_Address;

end GL.Loader;

Fix pragma Linker_Options in package GL.Loader on Windows

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


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

--  === Attributes ===
--  The  <tt>Attributes</tt> package defines a simple management of attributes for
--  the wiki document parser.  Attribute lists are described by the <tt>Attribute_List</tt>
--  with some operations to append or query for an attribute.
package Wiki.Attributes is

   pragma Preelaborate;

   type Cursor is private;

   --  Get the attribute name.
   function Get_Name (Position : in Cursor) return String;

   --  Get the attribute value.
   function Get_Value (Position : in Cursor) return String;

   --  Get the attribute wide value.
   function Get_Wide_Value (Position : in Cursor) return Wiki.Strings.WString;

   --  Get the attribute wide value.
   function Get_Unbounded_Wide_Value (Position : in Cursor) return Wiki.Strings.UString;

   --  Returns True if the cursor has a valid attribute.
   function Has_Element (Position : in Cursor) return Boolean;

   --  Move the cursor to the next attribute.
   procedure Next (Position : in out Cursor);

   --  A list of attributes.
   type Attribute_List is private;

   --  Find the attribute with the given name.
   function Find (List : in Attribute_List;
                  Name : in String) return Cursor;

   --  Find the attribute with the given name and return its value.
   function Get_Attribute (List : in Attribute_List;
                           Name : in String) return Wiki.Strings.UString;

   --  Find the attribute with the given name and return its value.
   function Get_Attribute (List : in Attribute_List;
                           Name : in String) return Wiki.Strings.WString;

   --  Append the attribute to the attribute list.
   procedure Append (List  : in out Attribute_List;
                     Name  : in Wiki.Strings.WString;
                     Value : in Wiki.Strings.WString);

   --  Append the attribute to the attribute list.
   procedure Append (List  : in out Attribute_List;
                     Name  : in Wiki.Strings.UString;
                     Value : in Wiki.Strings.UString);

   --  Append the attribute to the attribute list.
   procedure Append (List  : in out Attribute_List;
                     Name  : in String;
                     Value : in Wiki.Strings.UString);

   --  Get the cursor to get access to the first attribute.
   function First (List : in Attribute_List) return Cursor;

   --  Get the number of attributes in the list.
   function Length (List : in Attribute_List) return Natural;

   --  Clear the list and remove all existing attributes.
   procedure Clear (List : in out Attribute_List);

   --  Iterate over the list attributes and call the <tt>Process</tt> procedure.
   procedure Iterate (List    : in Attribute_List;
                      Process : not null access procedure (Name  : in String;
                                                           Value : in Wiki.Strings.WString));

private

   type Attribute (Name_Length, Value_Length : Natural) is limited
   new Util.Refs.Ref_Entity with record
      Name   : String (1 .. Name_Length);
      Value  : Wiki.Strings.WString (1 .. Value_Length);
   end record;
   type Attribute_Access is access all Attribute;

   package Attribute_Refs is new Util.Refs.Indefinite_References (Attribute, Attribute_Access);

   use Attribute_Refs;

   subtype Attribute_Ref is Attribute_Refs.Ref;

   package Attribute_Vectors is
     new Ada.Containers.Vectors (Index_Type   => Positive,
                                 Element_Type => Attribute_Ref);

   subtype Attribute_Vector is Attribute_Vectors.Vector;

   type Cursor is record
      Pos : Attribute_Vectors.Cursor;
   end record;

   type Attribute_List is new Ada.Finalization.Controlled with record
      List    : Attribute_Vector;
   end record;

   --  Finalize the attribute list releasing any storage.
   overriding
   procedure Finalize (List : in out Attribute_List);

end Wiki.Attributes;

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

--  === Attributes ===
--  The  <tt>Attributes</tt> package defines a simple management of attributes for
--  the wiki document parser.  Attribute lists are described by the <tt>Attribute_List</tt>
--  with some operations to append or query for an attribute.
package Wiki.Attributes is

   pragma Preelaborate;

   type Cursor is private;

   --  Get the attribute name.
   function Get_Name (Position : in Cursor) return String;

   --  Get the attribute value.
   function Get_Value (Position : in Cursor) return String;

   --  Get the attribute wide value.
   function Get_Wide_Value (Position : in Cursor) return Wiki.Strings.WString;

   --  Get the attribute wide value.
   function Get_Unbounded_Wide_Value (Position : in Cursor) return Wiki.Strings.UString;

   --  Returns True if the cursor has a valid attribute.
   function Has_Element (Position : in Cursor) return Boolean;

   --  Move the cursor to the next attribute.
   procedure Next (Position : in out Cursor);

   --  A list of attributes.
   type Attribute_List is private;

   --  Find the attribute with the given name.
   function Find (List : in Attribute_List;
                  Name : in String) return Cursor;

   --  Find the attribute with the given name and return its value.
   function Get_Attribute (List : in Attribute_List;
                           Name : in String) return Wiki.Strings.UString;

   --  Find the attribute with the given name and return its value.
   function Get_Attribute (List : in Attribute_List;
                           Name : in String) return Wiki.Strings.WString;

   --  Append the attribute to the attribute list.
   procedure Append (List  : in out Attribute_List;
                     Name  : in Wiki.Strings.WString;
                     Value : in Wiki.Strings.WString);

   --  Append the attribute to the attribute list.
   procedure Append (List  : in out Attribute_List;
                     Name  : in String;
                     Value : in Wiki.Strings.WString);

   --  Append the attribute to the attribute list.
   procedure Append (List  : in out Attribute_List;
                     Name  : in Wiki.Strings.UString;
                     Value : in Wiki.Strings.UString);

   --  Append the attribute to the attribute list.
   procedure Append (List  : in out Attribute_List;
                     Name  : in String;
                     Value : in Wiki.Strings.UString);

   --  Get the cursor to get access to the first attribute.
   function First (List : in Attribute_List) return Cursor;

   --  Get the number of attributes in the list.
   function Length (List : in Attribute_List) return Natural;

   --  Clear the list and remove all existing attributes.
   procedure Clear (List : in out Attribute_List);

   --  Iterate over the list attributes and call the <tt>Process</tt> procedure.
   procedure Iterate (List    : in Attribute_List;
                      Process : not null access procedure (Name  : in String;
                                                           Value : in Wiki.Strings.WString));

private

   type Attribute (Name_Length, Value_Length : Natural) is limited
   new Util.Refs.Ref_Entity with record
      Name   : String (1 .. Name_Length);
      Value  : Wiki.Strings.WString (1 .. Value_Length);
   end record;
   type Attribute_Access is access all Attribute;

   package Attribute_Refs is new Util.Refs.Indefinite_References (Attribute, Attribute_Access);

   use Attribute_Refs;

   subtype Attribute_Ref is Attribute_Refs.Ref;

   package Attribute_Vectors is
     new Ada.Containers.Vectors (Index_Type   => Positive,
                                 Element_Type => Attribute_Ref);

   subtype Attribute_Vector is Attribute_Vectors.Vector;

   type Cursor is record
      Pos : Attribute_Vectors.Cursor;
   end record;

   type Attribute_List is new Ada.Finalization.Controlled with record
      List    : Attribute_Vector;
   end record;

   --  Finalize the attribute list releasing any storage.
   overriding
   procedure Finalize (List : in out Attribute_List);

end Wiki.Attributes;

Declare a new Append procedure

Declare a new Append procedure


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

with ADO.Tests;
with ADO.Drivers.Tests;
with ADO.Sequences.Tests;
with ADO.Schemas.Tests;
with ADO.Objects.Tests;
with ADO.Queries.Tests;
with ADO.Parameters.Tests;
with ADO.Datasets.Tests;
with ADO.Statements.Tests;
package body ADO.Testsuite is

   use ADO.Tests;

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

   procedure Drivers (Suite : in Util.Tests.Access_Test_Suite) is separate;

   Tests : aliased Util.Tests.Test_Suite;

   function Suite return Util.Tests.Access_Test_Suite is
      Ret : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      ADO.Drivers.Tests.Add_Tests (Ret);
      ADO.Parameters.Tests.Add_Tests (Ret);
      ADO.Sequences.Tests.Add_Tests (Ret);
      ADO.Objects.Tests.Add_Tests (Ret);
      ADO.Statements.Tests.Add_Tests (Ret);
      ADO.Tests.Add_Tests (Ret);
      ADO.Schemas.Tests.Add_Tests (Ret);
      Drivers (Ret);
      ADO.Queries.Tests.Add_Tests (Ret);
      ADO.Datasets.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

end ADO.Testsuite;

-----------------------------------------------------------------------
--  ado-testsuite -- Testsuite for ADO
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 2015, 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 ADO.Tests;
with ADO.Drivers.Tests;
with ADO.Sequences.Tests;
with ADO.Schemas.Tests;
with ADO.Objects.Tests;
with ADO.Queries.Tests;
with ADO.Parameters.Tests;
with ADO.Datasets.Tests;
with ADO.Statements.Tests;
package body ADO.Testsuite is

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

   procedure Drivers (Suite : in Util.Tests.Access_Test_Suite) is separate;

   Tests : aliased Util.Tests.Test_Suite;

   function Suite return Util.Tests.Access_Test_Suite is
      Ret : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      ADO.Drivers.Tests.Add_Tests (Ret);
      ADO.Parameters.Tests.Add_Tests (Ret);
      ADO.Sequences.Tests.Add_Tests (Ret);
      ADO.Objects.Tests.Add_Tests (Ret);
      ADO.Statements.Tests.Add_Tests (Ret);
      ADO.Tests.Add_Tests (Ret);
      ADO.Schemas.Tests.Add_Tests (Ret);
      Drivers (Ret);
      ADO.Queries.Tests.Add_Tests (Ret);
      ADO.Datasets.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

end ADO.Testsuite;

Remove unecessary use clause

Remove unecessary use clause


-----------------------------------------------------------------------
--  serialize-io-csv-tests -- Unit tests for CSV parser
--  Copyright (C) 2011, 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Streams.Stream_IO;
with Util.Test_Caller;
with Util.Streams.Files;
with Util.Serialize.Mappers.Tests;
with Util.Serialize.IO.JSON.Tests;
package body Util.Serialize.IO.CSV.Tests is

   package Caller is new Util.Test_Caller (Test, "Serialize.IO.CSV");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.CSV.Parse (parse Ok)",
                       Test_Parser'Access);
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.CSV.Write",
                       Test_Output'Access);
   end Add_Tests;

   --  ------------------------------
   --  Check various (basic) JSON valid strings (no mapper).
   --  ------------------------------
   procedure Test_Parser (T : in out Test) is
      use Util.Serialize.Mappers.Tests;

      procedure Check_Parse (Content : in String;
                             Expect   : in Integer);

      Mapping        : aliased Util.Serialize.Mappers.Tests.Map_Test_Mapper.Mapper;
      Vector_Mapper  : aliased Util.Serialize.Mappers.Tests.Map_Test_Vector_Mapper.Mapper;

      procedure Check_Parse (Content : in String;
                             Expect : in Integer) is
         P : Parser;

         Value   : aliased Map_Test_Vector.Vector;
         Mapper  : Util.Serialize.Mappers.Processing;
      begin
         Mapper.Add_Mapping ("", Vector_Mapper'Unchecked_Access);
         Map_Test_Vector_Mapper.Set_Context (Mapper, Value'Unchecked_Access);

         P.Parse_String (Content, Mapper);

         T.Assert (not P.Has_Error, "Parse error for: " & Content);
         Util.Tests.Assert_Equals (T, 1, Integer (Value.Length), "Invalid result length");

         Util.Tests.Assert_Equals (T, Expect, Integer (Value.Element (1).Value), "Invalid value");
      end Check_Parse;

      HDR : constant String := "name,status,value,bool" & ASCII.CR & ASCII.LF;
   begin
      Mapping.Add_Mapping ("name", FIELD_NAME);
      Mapping.Add_Mapping ("value", FIELD_VALUE);
      Mapping.Add_Mapping ("status", FIELD_BOOL);
      Mapping.Add_Mapping ("bool", FIELD_BOOL);
      Vector_Mapper.Set_Mapping (Mapping'Unchecked_Access);

      Check_Parse (HDR & "joe,false,23,true", 23);
      Check_Parse (HDR & "billy,false,""12"",true", 12);
      Check_Parse (HDR & """John Potter"",false,""1234"",true", 1234);
      Check_Parse (HDR & """John" & ASCII.CR & "Potter"",False,""3234"",True", 3234);
      Check_Parse (HDR & """John" & ASCII.LF & "Potter"",False,""3234"",True", 3234);
   end Test_Parser;

   --  ------------------------------
   --  Test the CSV output stream generation.
   --  ------------------------------
   procedure Test_Output (T : in out Test) is
      File   : aliased Util.Streams.Files.File_Stream;
      Stream : Util.Serialize.IO.CSV.Output_Stream;
      Expect : constant String := Util.Tests.Get_Path ("regtests/expect/test-stream.csv");
      Path   : constant String := Util.Tests.Get_Test_Path ("regtests/result/test-stream.csv");
   begin
      File.Create (Mode => Ada.Streams.Stream_IO.Out_File, Name => Path);
      Stream.Initialize (Output => File'Unchecked_Access, Input => null, Size => 10000);
      Util.Serialize.IO.JSON.Tests.Write_Stream (Stream);
      Stream.Close;
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => Expect,
                                     Test    => Path,
                                     Message => "CSV output serialization");
   end Test_Output;

end Util.Serialize.IO.CSV.Tests;

-----------------------------------------------------------------------
--  serialize-io-csv-tests -- Unit tests for CSV parser
--  Copyright (C) 2011, 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Streams.Stream_IO;
with Util.Test_Caller;
with Util.Streams.Files;
with Util.Serialize.Mappers.Tests;
with Util.Serialize.IO.JSON.Tests;
package body Util.Serialize.IO.CSV.Tests is

   package Caller is new Util.Test_Caller (Test, "Serialize.IO.CSV");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.CSV.Parse (parse Ok)",
                       Test_Parser'Access);
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.CSV.Write",
                       Test_Output'Access);
   end Add_Tests;

   --  ------------------------------
   --  Check various (basic) JSON valid strings (no mapper).
   --  ------------------------------
   procedure Test_Parser (T : in out Test) is
      use Util.Serialize.Mappers.Tests;

      procedure Check_Parse (Content : in String;
                             Expect   : in Integer);

      Mapping        : aliased Util.Serialize.Mappers.Tests.Map_Test_Mapper.Mapper;
      Vector_Mapper  : aliased Util.Serialize.Mappers.Tests.Map_Test_Vector_Mapper.Mapper;

      procedure Check_Parse (Content : in String;
                             Expect : in Integer) is
         P : Parser;

         Value   : aliased Map_Test_Vector.Vector;
         Mapper  : Util.Serialize.Mappers.Processing;
      begin
         Mapper.Add_Mapping ("", Vector_Mapper'Unchecked_Access);
         Map_Test_Vector_Mapper.Set_Context (Mapper, Value'Unchecked_Access);

         P.Parse_String (Content, Mapper);

         T.Assert (not P.Has_Error, "Parse error for: " & Content);
         Util.Tests.Assert_Equals (T, 1, Integer (Value.Length), "Invalid result length");

         Util.Tests.Assert_Equals (T, Expect, Integer (Value.Element (1).Value), "Invalid value");
      end Check_Parse;

      HDR : constant String := "name,status,value,bool" & ASCII.CR & ASCII.LF;
   begin
      Mapping.Add_Mapping ("name", FIELD_NAME);
      Mapping.Add_Mapping ("value", FIELD_VALUE);
      Mapping.Add_Mapping ("status", FIELD_BOOL);
      Mapping.Add_Mapping ("bool", FIELD_BOOL);
      Vector_Mapper.Set_Mapping (Mapping'Unchecked_Access);

      Check_Parse (HDR & "joe,false,23,true", 23);
      Check_Parse (HDR & "billy,false,""12"",true", 12);
      Check_Parse (HDR & """John Potter"",false,""1234"",true", 1234);
      Check_Parse (HDR & """John" & ASCII.CR & "Potter"",False,""3234"",True", 3234);
      Check_Parse (HDR & """John" & ASCII.LF & "Potter"",False,""3234"",True", 3234);
   end Test_Parser;

   --  ------------------------------
   --  Test the CSV output stream generation.
   --  ------------------------------
   procedure Test_Output (T : in out Test) is
      File   : aliased Util.Streams.Files.File_Stream;
      Stream : Util.Serialize.IO.CSV.Output_Stream;
      Expect : constant String := Util.Tests.Get_Path ("regtests/expect/test-stream.csv");
      Path   : constant String := Util.Tests.Get_Test_Path ("regtests/result/test-stream.csv");
   begin
      File.Create (Mode => Ada.Streams.Stream_IO.Out_File, Name => Path);
      Stream.Initialize (Output => File'Unchecked_Access, Size => 10000);
      Util.Serialize.IO.JSON.Tests.Write_Stream (Stream);
      Stream.Close;
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => Expect,
                                     Test    => Path,
                                     Message => "CSV output serialization");
   end Test_Output;

end Util.Serialize.IO.CSV.Tests;

Update Print_Stream initialization

Update Print_Stream initialization