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

   pragma Preelaborate;

   --  -----------------------
   --  Buffered stream
   --  -----------------------
   --  The Buffered_Stream is an output/input stream which uses
   --  an intermediate buffer.  It can be configured to read or write to
   --  another stream that it will read or write using the buffer.
   --
   --  It is necessary to call Flush to make sure the data
   --  is written to the target stream.  The Flush operation will
   --  be called when finalizing the buffered stream.
   type Buffered_Stream is limited new Output_Stream and Input_Stream with private;

   type Buffer_Access is access Ada.Streams.Stream_Element_Array;

   --  Initialize the stream to read or write on the given streams.
   --  An internal buffer is allocated for writing the stream.
   procedure Initialize (Stream  : in out Buffered_Stream;
                         Output  : in Output_Stream_Access;
                         Input   : in Input_Stream_Access;
                         Size    : in Positive);

   --  Initialize the stream with a buffer of Size bytes.
   procedure Initialize (Stream  : in out Buffered_Stream;
                         Size    : in Positive);

   --  Initialize the stream to read from the string.
   procedure Initialize (Stream  : in out Buffered_Stream;
                         Content : in String);

   --  Close the sink.
   overriding
   procedure Close (Stream : in out Buffered_Stream);

   --  Get the direct access to the buffer.
   function Get_Buffer (Stream : in Buffered_Stream) return Buffer_Access;

   --  Write a raw character on the stream.
   procedure Write (Stream : in out Buffered_Stream;
                    Char   : in Character);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Buffered_Stream;
                    Item   : in String);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Buffered_Stream;
                    Item   : in Ada.Strings.Unbounded.Unbounded_String);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Buffered_Stream;
                    Item   : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String);

   --  Write the buffer array to the output stream.
   overriding
   procedure Write (Stream : in out Buffered_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array);

   --  Flush the buffer by writing on the output stream.
   --  Raises Data_Error if there is no output stream.
   overriding
   procedure Flush (Stream : in out Buffered_Stream);

   --  Get the number of element in the stream.
   function Get_Size (Stream : in Buffered_Stream) return Natural;

   --  Fill the buffer by reading the input stream.
   --  Raises Data_Error if there is no input stream;
   procedure Fill (Stream : in out Buffered_Stream);

   --  Read one character from the input stream.
   procedure Read (Stream : in out Buffered_Stream;
                   Char   : out Character);

   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   overriding
   procedure Read (Stream : in out Buffered_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset);

   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   procedure Read (Stream : in out Buffered_Stream;
                   Into   : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Returns True if the end of the stream is reached.
   function Is_Eof (Stream : in Buffered_Stream) return Boolean;

private

   use Ada.Streams;

   type Buffered_Stream is limited new Ada.Finalization.Limited_Controlled
     and Output_Stream and Input_Stream with record
      --  The buffer where the data is written before being flushed.
      Buffer      : Buffer_Access := null;

      --  The next write position within the buffer.
      Write_Pos   : Stream_Element_Offset := 0;

      --  The next read position within the buffer.
      Read_Pos    : Stream_Element_Offset := 1;

      --  The last valid write position within the buffer.
      Last        : Stream_Element_Offset := 0;

      --  The output stream to use for flushing the buffer.
      Output      : Output_Stream_Access := null;

      --  The input stream to use to fill the buffer.
      Input       : Input_Stream_Access := null;

      No_Flush    : Boolean := False;

      --  Reached end of file when reading.
      Eof         : Boolean := False;
   end record;

   --  Flush the stream and release the buffer.
   overriding
   procedure Finalize (Object : in out Buffered_Stream);

end Util.Streams.Buffered;

-----------------------------------------------------------------------
--  Util.Streams.Buffered -- Buffered streams Stream utilities
--  Copyright (C) 2010, 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 Ada.Strings.Unbounded;
with Ada.Strings.Wide_Wide_Unbounded;
with Ada.Finalization;
package Util.Streams.Buffered is

   pragma Preelaborate;

   --  -----------------------
   --  Buffered stream
   --  -----------------------
   --  The Buffered_Stream is an output/input stream which uses
   --  an intermediate buffer.  It can be configured to read or write to
   --  another stream that it will read or write using the buffer.
   --
   --  It is necessary to call Flush to make sure the data
   --  is written to the target stream.  The Flush operation will
   --  be called when finalizing the buffered stream.
   type Buffered_Stream is limited new Output_Stream and Input_Stream with private;

   type Buffer_Access is access Ada.Streams.Stream_Element_Array;

   --  Initialize the stream to read or write on the given streams.
   --  An internal buffer is allocated for writing the stream.
   procedure Initialize (Stream  : in out Buffered_Stream;
                         Output  : in Output_Stream_Access;
                         Input   : in Input_Stream_Access;
                         Size    : in Positive);

   --  Initialize the stream with a buffer of Size bytes.
   procedure Initialize (Stream  : in out Buffered_Stream;
                         Size    : in Positive);

   --  Initialize the stream to read from the string.
   procedure Initialize (Stream  : in out Buffered_Stream;
                         Content : in String);

   --  Close the sink.
   overriding
   procedure Close (Stream : in out Buffered_Stream);

   --  Get the direct access to the buffer.
   function Get_Buffer (Stream : in Buffered_Stream) return Buffer_Access;

   --  Write a raw character on the stream.
   procedure Write (Stream : in out Buffered_Stream;
                    Char   : in Character);

   --  Write a wide character on the stream doing some conversion if necessary.
   --  The default implementation translates the wide character to a UTF-8 sequence.
   procedure Write_Wide (Stream : in out Buffered_Stream;
                         Item   : in Wide_Wide_Character);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Buffered_Stream;
                    Item   : in String);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Buffered_Stream;
                    Item   : in Ada.Strings.Unbounded.Unbounded_String);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Buffered_Stream;
                    Item   : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String);

   --  Write the buffer array to the output stream.
   overriding
   procedure Write (Stream : in out Buffered_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array);

   --  Flush the buffer by writing on the output stream.
   --  Raises Data_Error if there is no output stream.
   overriding
   procedure Flush (Stream : in out Buffered_Stream);

   --  Get the number of element in the stream.
   function Get_Size (Stream : in Buffered_Stream) return Natural;

   --  Fill the buffer by reading the input stream.
   --  Raises Data_Error if there is no input stream;
   procedure Fill (Stream : in out Buffered_Stream);

   --  Read one character from the input stream.
   procedure Read (Stream : in out Buffered_Stream;
                   Char   : out Character);

   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   overriding
   procedure Read (Stream : in out Buffered_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset);

   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   procedure Read (Stream : in out Buffered_Stream;
                   Into   : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Returns True if the end of the stream is reached.
   function Is_Eof (Stream : in Buffered_Stream) return Boolean;

private

   use Ada.Streams;

   type Buffered_Stream is limited new Ada.Finalization.Limited_Controlled
     and Output_Stream and Input_Stream with record
      --  The buffer where the data is written before being flushed.
      Buffer      : Buffer_Access := null;

      --  The next write position within the buffer.
      Write_Pos   : Stream_Element_Offset := 0;

      --  The next read position within the buffer.
      Read_Pos    : Stream_Element_Offset := 1;

      --  The last valid write position within the buffer.
      Last        : Stream_Element_Offset := 0;

      --  The output stream to use for flushing the buffer.
      Output      : Output_Stream_Access := null;

      --  The input stream to use to fill the buffer.
      Input       : Input_Stream_Access := null;

      No_Flush    : Boolean := False;

      --  Reached end of file when reading.
      Eof         : Boolean := False;
   end record;

   --  Flush the stream and release the buffer.
   overriding
   procedure Finalize (Object : in out Buffered_Stream);

end Util.Streams.Buffered;

Declare the Write_Wide procedure to write a wide wide character (use a different name to avoid problems writing single literal characters)


--  Used for all testcases for MySQL driver
--  Modify connection parameters as necessary

with AdaBase.Driver.Base.MySQL;

package body Connect is

   procedure connect_database is
   begin
      DR.basic_connect (database => "adabase_examples",
                        username => "root",
                        password => "",
                        hostname => "localhost",
                        port     => 3306);
   end connect_database;

end Connect;

--  Used for all testcases for MySQL driver
--  Modify connection parameters as necessary

package body Connect is

   procedure connect_database is
   begin
      DR.basic_connect (database => "adabase_examples",
                        username => "root",
                        password => "",
                        hostname => "localhost",
                        port     => 3306);
   end connect_database;

end Connect;

Remove unnecessary WITH from mysql connection


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

with Ada.Exceptions;

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

with ASF.Locales;
with ASF.Applications.Main;
package body ASF.Applications.Messages.Factory is

   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("ASF.Applications.Messages.Factory");

   --  ------------------------------
   --  Get a localized message.  The message identifier is composed of a resource bundle name
   --  prefix and a bundle key.  The prefix and key are separated by the first '.'.
   --  If the message identifier does not contain any prefix, the default bundle is "messages".
   --  ------------------------------
   function Get_Message (Context    : in ASF.Contexts.Faces.Faces_Context'Class;
                         Message_Id : in String) return String is
      Pos    : constant Natural := Util.Strings.Index (Message_Id, '.');
      App    : constant access ASF.Applications.Main.Application'Class := Context.Get_Application;
      Bundle : ASF.Locales.Bundle;
   begin
      if Pos > 0 then
         App.Load_Bundle (Name   => Message_Id (Message_Id'First .. Pos - 1),
                          Locale => "en",
                          Bundle => Bundle);
         return Bundle.Get (Message_Id (Pos + 1 .. Message_Id'Last),
                            Message_Id (Pos + 1 .. Message_Id'Last));
      else
         App.Load_Bundle (Name   => "messages",
                          Locale => "en",
                          Bundle => Bundle);
         return Bundle.Get (Message_Id, Message_Id);
      end if;

   exception
      when E : Util.Properties.Bundles.NO_BUNDLE =>
         Log.Error ("Cannot localize {0}: {1}", Message_Id, Ada.Exceptions.Exception_Message (E));
         return Message_Id;
   end Get_Message;

   --  ------------------------------
   --  Build a localized message.
   --  ------------------------------
   function Get_Message (Context    : in ASF.Contexts.Faces.Faces_Context'Class;
                         Message_Id : in String;
                         Severity   : in Messages.Severity := ERROR) return Message is
      Msg    : constant String := Get_Message (Context, Message_Id);
      Result : Message;
   begin
      Result.Summary := Ada.Strings.Unbounded.To_Unbounded_String (Msg);
      Result.Kind    := Severity;
      return Result;
   end Get_Message;

   --  ------------------------------
   --  Build a localized message and format the message with one argument.
   --  ------------------------------
   function Get_Message (Context    : in ASF.Contexts.Faces.Faces_Context'Class;
                         Message_Id : in String;
                         Param1     : in String;
                         Severity   : in Messages.Severity := ERROR) return Message is
      Args : ASF.Utils.Object_Array (1 .. 1);
   begin
      Args (1) := Util.Beans.Objects.To_Object (Param1);
      return Get_Message (Context, Message_Id, Args, Severity);
   end Get_Message;

   --  ------------------------------
   --  Build a localized message and format the message with two argument.
   --  ------------------------------
   function Get_Message (Context    : in ASF.Contexts.Faces.Faces_Context'Class;
                         Message_Id : in String;
                         Param1     : in String;
                         Param2     : in String;
                         Severity   : in Messages.Severity := ERROR) return Message is
      Args : ASF.Utils.Object_Array (1 .. 2);
   begin
      Args (1) := Util.Beans.Objects.To_Object (Param1);
      Args (2) := Util.Beans.Objects.To_Object (Param2);
      return Get_Message (Context, Message_Id, Args, Severity);
   end Get_Message;

   --  ------------------------------
   --  Build a localized message and format the message with some arguments.
   --  ------------------------------
   function Get_Message (Context    : in ASF.Contexts.Faces.Faces_Context'Class;
                         Message_Id : in String;
                         Args       : in ASF.Utils.Object_Array;
                         Severity   : in Messages.Severity := ERROR) return Message is
      Msg    : constant String := Get_Message (Context, Message_Id);
      Result : Message;
   begin
      Result.Kind := Severity;
      ASF.Utils.Formats.Format (Msg, Args, Result.Summary);
      return Result;
   end Get_Message;

   --  ------------------------------
   --  Add a localized global message in the faces context.
   --  ------------------------------
   procedure Add_Message (Context    : in out ASF.Contexts.Faces.Faces_Context'Class;
                          Message_Id : in String;
                          Param1     : in String;
                          Severity   : in Messages.Severity := ERROR) is
      Msg     : constant Message := Get_Message (Context, Message_Id, Param1, Severity);
   begin
      Context.Add_Message (Client_Id => "", Message  => Msg);
   end Add_Message;

   --  ------------------------------
   --  Add a localized global message in the faces context.
   --  ------------------------------
   procedure Add_Message (Context    : in out ASF.Contexts.Faces.Faces_Context'Class;
                          Message_Id : in String;
                          Severity   : in Messages.Severity := ERROR) is
      Msg     : constant Message := Get_Message (Context, Message_Id, Severity);
   begin
      Context.Add_Message (Client_Id => "", Message  => Msg);
   end Add_Message;

   --  ------------------------------
   --  Add a localized global message in the current faces context.
   --  ------------------------------
   procedure Add_Message (Message_Id : in String;
                          Severity   : in Messages.Severity := ERROR) is
      Context : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
   begin
      Add_Message (Context.all, Message_Id, Severity);
   end Add_Message;

end ASF.Applications.Messages.Factory;

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

with Ada.Exceptions;

with Util.Log.Loggers;
with Util.Properties.Bundles;
with Util.Beans.Objects;
with Util.Locales;

with ASF.Locales;
with ASF.Applications.Main;
package body ASF.Applications.Messages.Factory is

   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("ASF.Applications.Messages.Factory");

   --  ------------------------------
   --  Get a localized message.  The message identifier is composed of a resource bundle name
   --  prefix and a bundle key.  The prefix and key are separated by the first '.'.
   --  If the message identifier does not contain any prefix, the default bundle is "messages".
   --  ------------------------------
   function Get_Message (Context    : in ASF.Contexts.Faces.Faces_Context'Class;
                         Message_Id : in String) return String is
      Pos    : constant Natural := Util.Strings.Index (Message_Id, '.');
      Locale : constant Util.Locales.Locale := Context.Get_Locale;
      App    : constant access ASF.Applications.Main.Application'Class := Context.Get_Application;
      Bundle : ASF.Locales.Bundle;
   begin
      if Pos > 0 then
         App.Load_Bundle (Name   => Message_Id (Message_Id'First .. Pos - 1),
                          Locale => Util.Locales.To_String (Locale),
                          Bundle => Bundle);
         return Bundle.Get (Message_Id (Pos + 1 .. Message_Id'Last),
                            Message_Id (Pos + 1 .. Message_Id'Last));
      else
         App.Load_Bundle (Name   => "messages",
                          Locale => Util.Locales.To_String (Locale),
                          Bundle => Bundle);
         return Bundle.Get (Message_Id, Message_Id);
      end if;

   exception
      when E : Util.Properties.Bundles.NO_BUNDLE =>
         Log.Error ("Cannot localize {0}: {1}", Message_Id, Ada.Exceptions.Exception_Message (E));
         return Message_Id;
   end Get_Message;

   --  ------------------------------
   --  Build a localized message.
   --  ------------------------------
   function Get_Message (Context    : in ASF.Contexts.Faces.Faces_Context'Class;
                         Message_Id : in String;
                         Severity   : in Messages.Severity := ERROR) return Message is
      Msg    : constant String := Get_Message (Context, Message_Id);
      Result : Message;
   begin
      Result.Summary := Ada.Strings.Unbounded.To_Unbounded_String (Msg);
      Result.Kind    := Severity;
      return Result;
   end Get_Message;

   --  ------------------------------
   --  Build a localized message and format the message with one argument.
   --  ------------------------------
   function Get_Message (Context    : in ASF.Contexts.Faces.Faces_Context'Class;
                         Message_Id : in String;
                         Param1     : in String;
                         Severity   : in Messages.Severity := ERROR) return Message is
      Args : ASF.Utils.Object_Array (1 .. 1);
   begin
      Args (1) := Util.Beans.Objects.To_Object (Param1);
      return Get_Message (Context, Message_Id, Args, Severity);
   end Get_Message;

   --  ------------------------------
   --  Build a localized message and format the message with two argument.
   --  ------------------------------
   function Get_Message (Context    : in ASF.Contexts.Faces.Faces_Context'Class;
                         Message_Id : in String;
                         Param1     : in String;
                         Param2     : in String;
                         Severity   : in Messages.Severity := ERROR) return Message is
      Args : ASF.Utils.Object_Array (1 .. 2);
   begin
      Args (1) := Util.Beans.Objects.To_Object (Param1);
      Args (2) := Util.Beans.Objects.To_Object (Param2);
      return Get_Message (Context, Message_Id, Args, Severity);
   end Get_Message;

   --  ------------------------------
   --  Build a localized message and format the message with some arguments.
   --  ------------------------------
   function Get_Message (Context    : in ASF.Contexts.Faces.Faces_Context'Class;
                         Message_Id : in String;
                         Args       : in ASF.Utils.Object_Array;
                         Severity   : in Messages.Severity := ERROR) return Message is
      Msg    : constant String := Get_Message (Context, Message_Id);
      Result : Message;
   begin
      Result.Kind := Severity;
      ASF.Utils.Formats.Format (Msg, Args, Result.Summary);
      return Result;
   end Get_Message;

   --  ------------------------------
   --  Add a localized global message in the faces context.
   --  ------------------------------
   procedure Add_Message (Context    : in out ASF.Contexts.Faces.Faces_Context'Class;
                          Message_Id : in String;
                          Param1     : in String;
                          Severity   : in Messages.Severity := ERROR) is
      Msg     : constant Message := Get_Message (Context, Message_Id, Param1, Severity);
   begin
      Context.Add_Message (Client_Id => "", Message  => Msg);
   end Add_Message;

   --  ------------------------------
   --  Add a localized global message in the faces context.
   --  ------------------------------
   procedure Add_Message (Context    : in out ASF.Contexts.Faces.Faces_Context'Class;
                          Message_Id : in String;
                          Severity   : in Messages.Severity := ERROR) is
      Msg     : constant Message := Get_Message (Context, Message_Id, Severity);
   begin
      Context.Add_Message (Client_Id => "", Message  => Msg);
   end Add_Message;

   --  ------------------------------
   --  Add a localized global message in the current faces context.
   --  ------------------------------
   procedure Add_Message (Message_Id : in String;
                          Severity   : in Messages.Severity := ERROR) is
      Context : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
   begin
      Add_Message (Context.all, Message_Id, Severity);
   end Add_Message;

end ASF.Applications.Messages.Factory;

Use the context locale to localize the message


--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   synth_version_major : constant String := "1";
   synth_version_minor : constant String := "03";
   copyright_years     : constant String := "2015-2016";
   host_localbase      : constant String := "/usr/local";
   host_pkg8           : constant String := host_localbase & "/sbin/pkg";
   jobs_per_cpu        : constant := 2;

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;

end Definitions;

--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   synth_version_major : constant String := "1";
   synth_version_minor : constant String := "10";
   copyright_years     : constant String := "2015-2016";
   host_localbase      : constant String := "/usr/local";
   host_pkg8           : constant String := host_localbase & "/sbin/pkg";
   jobs_per_cpu        : constant := 2;

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;

end Definitions;

Bump to version 1.10 (enhancement is worth a release)

The repository rebuild time improvement is a high-visibility request
so it's worth a new release by itself.


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

with Util.Systems.Os;
with Interfaces.C;
private package Util.Processes.Os is

   use Util.Systems.Os;

   SHELL : constant String := "";

   type Wchar_Ptr is access all Interfaces.C.wchar_array;

   type System_Process is new Util.Processes.System_Process with record
      Process_Info : aliased Util.Systems.Os.PROCESS_INFORMATION;
      Command      : Wchar_Ptr := null;
      Pos          : Interfaces.C.size_t := 0;
      In_File      : Wchar_Ptr := null;
      Out_File     : Wchar_Ptr := null;
      Err_File     : Wchar_Ptr := null;
      Dir          : Wchar_Ptr := null;
      To_Close     : File_Type_Array_Access;
      Out_Append   : Boolean := False;
      Err_Append   : Boolean := False;
   end record;

   --  Wait for the process to exit.
   overriding
   procedure Wait (Sys     : in out System_Process;
                   Proc    : in out Process'Class;
                   Timeout : in Duration);

   --  Spawn a new process.
   overriding
   procedure Spawn (Sys  : in out System_Process;
                    Proc : in out Process'Class;
                    Mode : in Pipe_Mode := NONE);

   --  Terminate the process by sending a signal on Unix and exiting the process on Windows.
   --  This operation is not portable and has a different behavior between Unix and Windows.
   --  Its intent is to stop the process.
   overriding
   procedure Stop (Sys    : in out System_Process;
                   Proc   : in out Process'Class;
                   Signal : in Positive := 15);

   --  Append the argument to the process argument list.
   overriding
   procedure Append_Argument (Sys : in out System_Process;
                              Arg : in String);

   --  Set the process input, output and error streams to redirect and use specified files.
   overriding
   procedure Set_Streams (Sys           : in out System_Process;
                          Input         : in String;
                          Output        : in String;
                          Error         : in String;
                          Append_Output : in Boolean;
                          Append_Error  : in Boolean;
                          To_Close      : in File_Type_Array_Access);

   --  Deletes the storage held by the system process.
   overriding
   procedure Finalize (Sys : in out System_Process);

   --  Build the output pipe redirection to read the process output.
   procedure Build_Output_Pipe (Proc : in out Process'Class;
                                Into : in out Startup_Info);

   --  Build the input pipe redirection to write the process standard input.
   procedure Build_Input_Pipe (Proc : in out Process'Class;
                               Into : in out Startup_Info);

private

   --  Create the output stream to read/write on the process input/output.
   --  Setup the file to be closed on exec.
   function Create_Stream (File : in Util.Streams.Raw.File_Type)
                           return Util.Streams.Raw.Raw_Stream_Access;

end Util.Processes.Os;

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

with Util.Systems.Os;
with Interfaces.C;
private package Util.Processes.Os is

   use Util.Systems.Os;

   SHELL : constant String := "";

   subtype Wchar_Ptr is Util.Systems.Os.Wchar_Ptr;

   type System_Process is new Util.Processes.System_Process with record
      Process_Info : aliased Util.Systems.Os.PROCESS_INFORMATION;
      Command      : Wchar_Ptr := null;
      Pos          : Interfaces.C.size_t := 0;
      In_File      : Wchar_Ptr := null;
      Out_File     : Wchar_Ptr := null;
      Err_File     : Wchar_Ptr := null;
      Dir          : Wchar_Ptr := null;
      To_Close     : File_Type_Array_Access;
      Out_Append   : Boolean := False;
      Err_Append   : Boolean := False;
   end record;

   --  Wait for the process to exit.
   overriding
   procedure Wait (Sys     : in out System_Process;
                   Proc    : in out Process'Class;
                   Timeout : in Duration);

   --  Spawn a new process.
   overriding
   procedure Spawn (Sys  : in out System_Process;
                    Proc : in out Process'Class;
                    Mode : in Pipe_Mode := NONE);

   --  Terminate the process by sending a signal on Unix and exiting the process on Windows.
   --  This operation is not portable and has a different behavior between Unix and Windows.
   --  Its intent is to stop the process.
   overriding
   procedure Stop (Sys    : in out System_Process;
                   Proc   : in out Process'Class;
                   Signal : in Positive := 15);

   --  Append the argument to the process argument list.
   overriding
   procedure Append_Argument (Sys : in out System_Process;
                              Arg : in String);

   --  Set the process input, output and error streams to redirect and use specified files.
   overriding
   procedure Set_Streams (Sys           : in out System_Process;
                          Input         : in String;
                          Output        : in String;
                          Error         : in String;
                          Append_Output : in Boolean;
                          Append_Error  : in Boolean;
                          To_Close      : in File_Type_Array_Access);

   --  Deletes the storage held by the system process.
   overriding
   procedure Finalize (Sys : in out System_Process);

   --  Build the output pipe redirection to read the process output.
   procedure Build_Output_Pipe (Proc : in out Process'Class;
                                Into : in out Startup_Info);

   --  Build the input pipe redirection to write the process standard input.
   procedure Build_Input_Pipe (Proc : in out Process'Class;
                               Into : in out Startup_Info);

private

   --  Create the output stream to read/write on the process input/output.
   --  Setup the file to be closed on exec.
   function Create_Stream (File : in Util.Streams.Raw.File_Type)
                           return Util.Streams.Raw.Raw_Stream_Access;

end Util.Processes.Os;

Use Wchar_Ptr definition from Util.Systems.Os package


------------------------------------------------------------------------------
--                                                                          --
--                  Copyright (C) 2015-2016, 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    stm32f4xx_hal_usart.h                                         --
--   @author  MCD Application Team                                          --
--   @version V1.1.0                                                        --
--   @date    19-June-2014                                                  --
--   @brief   Header file of USARTS HAL module.                             --
--                                                                          --
--   COPYRIGHT(c) 2014 STMicroelectronics                                   --
------------------------------------------------------------------------------

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

--  Note that there are board implementation assumptions represented by the
--  private function APB_Clock.

pragma Restrictions (No_Elaboration_Code);

with System;
with HAL.UART; use HAL.UART;
private with STM32_SVD.USART;

package STM32.USARTs is

   type Internal_USART is limited private;

   type USART (Periph : not null access Internal_USART) is
     limited new HAL.UART.UART_Port with private;

   procedure Enable (This : in out USART) with
     Post => Enabled (This),
     Inline;

   procedure Disable (This : in out USART) with
     Post => not Enabled (This),
     Inline;

   function Enabled (This : USART) return Boolean with Inline;

   procedure Receive (This : USART;  Data : out UInt9) with Inline;
   --  reads Device.DR into Data

   function Current_Input (This : USART) return UInt9 with Inline;
   --  returns Device.DR

   procedure Transmit (This : in out USART;  Data : UInt9) with Inline;

   function Tx_Ready (This : USART) return Boolean with Inline;

   function Rx_Ready (This : USART) return Boolean with Inline;

   type Stop_Bits is (Stopbits_1, Stopbits_2) with Size => 2;

   for Stop_Bits use (Stopbits_1 => 0, Stopbits_2 => 2#10#);

   procedure Set_Stop_Bits (This : in out USART;  To : Stop_Bits);

   type Word_Lengths is (Word_Length_8, Word_Length_9);

   procedure Set_Word_Length (This : in out USART;  To : Word_Lengths);

   type Parities is (No_Parity, Even_Parity, Odd_Parity);

   procedure Set_Parity (This : in out USART;  To : Parities);

   subtype Baud_Rates is Word;

   procedure Set_Baud_Rate (This : in out USART;  To : Baud_Rates);

   type Oversampling_Modes is (Oversampling_By_8, Oversampling_By_16);
   --  oversampling by 16 is the default

   procedure Set_Oversampling_Mode
     (This : in out USART;
      To   : Oversampling_Modes);

   type UART_Modes is (Rx_Mode, Tx_Mode, Tx_Rx_Mode);

   procedure Set_Mode (This : in out USART;  To : UART_Modes);

   type Flow_Control is
     (No_Flow_Control,
      RTS_Flow_Control,
      CTS_Flow_Control,
      RTS_CTS_Flow_Control);

   procedure Set_Flow_Control (This : in out USART;  To : Flow_Control);

   type USART_Interrupt is
     (Parity_Error,
      Transmit_Data_Register_Empty,
      Transmission_Complete,
      Received_Data_Not_Empty,
      Idle_Line_Detection,
      Line_Break_Detection,
      Clear_To_Send,
      Error);

   procedure Enable_Interrupts
     (This   : in out USART;
      Source : USART_Interrupt)
     with
       Post => Interrupt_Enabled (This, Source),
       Inline;

   procedure Disable_Interrupts
     (This   : in out USART;
      Source : USART_Interrupt)
     with
       Post => not Interrupt_Enabled (This, Source),
        Inline;

   function Interrupt_Enabled
     (This   : USART;
      Source : USART_Interrupt)
      return Boolean
     with Inline;

   type USART_Status_Flag is
     (Parity_Error_Indicated,
      Framing_Error_Indicated,
      USART_Noise_Error_Indicated,
      Overrun_Error_Indicated,
      Idle_Line_Detection_Indicated,
      Read_Data_Register_Not_Empty,
      Transmission_Complete_Indicated,
      Transmit_Data_Register_Empty,
      Line_Break_Detection_Indicated,
      Clear_To_Send_Indicated);

   function Status (This : USART; Flag : USART_Status_Flag) return Boolean
     with Inline;

   procedure Clear_Status (This : in out USART; Flag : USART_Status_Flag)
     with Inline;

   procedure Enable_DMA_Transmit_Requests (This : in out USART) with
     Inline,
     Post => DMA_Transmit_Requests_Enabled (This);

   procedure Disable_DMA_Transmit_Requests (This : in out USART) with
     Inline,
     Post => not DMA_Transmit_Requests_Enabled (This);

   function DMA_Transmit_Requests_Enabled  (This : USART) return Boolean with
     Inline;

   procedure Enable_DMA_Receive_Requests (This : in out USART) with
     Inline,
     Post => DMA_Receive_Requests_Enabled (This);

   procedure Disable_DMA_Receive_Requests (This : in out USART) with
     Inline,
     Post => not DMA_Receive_Requests_Enabled (This);

   function DMA_Receive_Requests_Enabled  (This : USART) return Boolean with
     Inline;

   procedure Pause_DMA_Transmission (This : in out USART)
     renames Disable_DMA_Transmit_Requests;

   procedure Resume_DMA_Transmission (This : in out USART) with
     Inline,
     Post => DMA_Transmit_Requests_Enabled (This) and
             Enabled (This);

   procedure Pause_DMA_Reception (This : in out USART)
     renames Disable_DMA_Receive_Requests;

   procedure Resume_DMA_Reception (This : in out USART) with
     Inline,
     Post => DMA_Receive_Requests_Enabled (This) and
             Enabled (This);

   function Data_Register_Address (This : USART) return System.Address with
     Inline;
   --  Returns the address of the USART Data Register. This is exported
   --  STRICTLY for the sake of clients driving a USART via DMA. All other
   --  clients of this package should use the procedural interfaces Transmit
   --  and Receive instead of directly accessing the Data Register!
   --  Seriously, don't use this function otherwise.

   -----------------------------
   -- HAL.UART implementation --
   -----------------------------

   overriding
   function Data_Size (This : USART) return HAL.UART.UART_Data_Size;

   overriding
   procedure Transmit
     (Port    : in out USART;
      Data    : UART_Data_8b;
      Status  : out UART_Status;
      Timeout : Natural := 1000)
     with
       Pre'Class => Data_Size (Port) = Data_Size_8b;

   overriding
   procedure Transmit
     (Port    : in out USART;
      Data    : UART_Data_9b;
      Status  : out UART_Status;
      Timeout : Natural := 1000)
     with
       Pre'Class => Data_Size (Port) = Data_Size_9b;

   overriding
   procedure Receive
     (Port    : in out USART;
      Data    : out UART_Data_8b;
      Status  : out UART_Status;
      Timeout : Natural := 1000)
     with
       Pre'Class => Data_Size (Port) = Data_Size_8b;

   overriding
   procedure Receive
     (Port    : in out USART;
      Data    : out UART_Data_9b;
      Status  : out UART_Status;
      Timeout : Natural := 1000)
     with
       Pre'Class => Data_Size (Port) = Data_Size_9b;

private

   function APB_Clock (This : USART) return Word with Inline;
   --  Returns either APB1 or APB2 clock rate, in Hertz, depending on the
   --  USART. For the sake of not making this package board-specific, we assume
   --  that we are given a valid USART object at a valid address, AND that the
   --  USART devices really are configured such that only 1 and 6 are on APB2.
   --  Therefore, if a board has additional USARTs beyond USART6, eg USART8 on
   --  the F429I Discovery board, they better conform to that assumption.
   --  See Note # 2 in each of Tables 139-141 of the RM on pages 970 - 972.

   type Internal_USART is new STM32_SVD.USART.USART2_Peripheral;
   type USART (Periph : not null access Internal_USART) is
     limited new HAL.UART.UART_Port with null record;

end STM32.USARTs;

------------------------------------------------------------------------------
--                                                                          --
--                  Copyright (C) 2015-2016, 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    stm32f4xx_hal_usart.h                                         --
--   @author  MCD Application Team                                          --
--   @version V1.1.0                                                        --
--   @date    19-June-2014                                                  --
--   @brief   Header file of USARTS HAL module.                             --
--                                                                          --
--   COPYRIGHT(c) 2014 STMicroelectronics                                   --
------------------------------------------------------------------------------

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

--  Note that there are board implementation assumptions represented by the
--  private function APB_Clock.

with System;
with HAL.UART; use HAL.UART;
private with STM32_SVD.USART;

package STM32.USARTs is

   type Internal_USART is limited private;

   type USART (Periph : not null access Internal_USART) is
     limited new HAL.UART.UART_Port with private;

   procedure Enable (This : in out USART) with
     Post => Enabled (This),
     Inline;

   procedure Disable (This : in out USART) with
     Post => not Enabled (This),
     Inline;

   function Enabled (This : USART) return Boolean with Inline;

   procedure Receive (This : USART;  Data : out UInt9) with Inline;
   --  reads Device.DR into Data

   function Current_Input (This : USART) return UInt9 with Inline;
   --  returns Device.DR

   procedure Transmit (This : in out USART;  Data : UInt9) with Inline;

   function Tx_Ready (This : USART) return Boolean with Inline;

   function Rx_Ready (This : USART) return Boolean with Inline;

   type Stop_Bits is (Stopbits_1, Stopbits_2) with Size => 2;

   for Stop_Bits use (Stopbits_1 => 0, Stopbits_2 => 2#10#);

   procedure Set_Stop_Bits (This : in out USART;  To : Stop_Bits);

   type Word_Lengths is (Word_Length_8, Word_Length_9);

   procedure Set_Word_Length (This : in out USART;  To : Word_Lengths);

   type Parities is (No_Parity, Even_Parity, Odd_Parity);

   procedure Set_Parity (This : in out USART;  To : Parities);

   subtype Baud_Rates is Word;

   procedure Set_Baud_Rate (This : in out USART;  To : Baud_Rates);

   type Oversampling_Modes is (Oversampling_By_8, Oversampling_By_16);
   --  oversampling by 16 is the default

   procedure Set_Oversampling_Mode
     (This : in out USART;
      To   : Oversampling_Modes);

   type UART_Modes is (Rx_Mode, Tx_Mode, Tx_Rx_Mode);

   procedure Set_Mode (This : in out USART;  To : UART_Modes);

   type Flow_Control is
     (No_Flow_Control,
      RTS_Flow_Control,
      CTS_Flow_Control,
      RTS_CTS_Flow_Control);

   procedure Set_Flow_Control (This : in out USART;  To : Flow_Control);

   type USART_Interrupt is
     (Parity_Error,
      Transmit_Data_Register_Empty,
      Transmission_Complete,
      Received_Data_Not_Empty,
      Idle_Line_Detection,
      Line_Break_Detection,
      Clear_To_Send,
      Error);

   procedure Enable_Interrupts
     (This   : in out USART;
      Source : USART_Interrupt)
     with
       Post => Interrupt_Enabled (This, Source),
       Inline;

   procedure Disable_Interrupts
     (This   : in out USART;
      Source : USART_Interrupt)
     with
       Post => not Interrupt_Enabled (This, Source),
        Inline;

   function Interrupt_Enabled
     (This   : USART;
      Source : USART_Interrupt)
      return Boolean
     with Inline;

   type USART_Status_Flag is
     (Parity_Error_Indicated,
      Framing_Error_Indicated,
      USART_Noise_Error_Indicated,
      Overrun_Error_Indicated,
      Idle_Line_Detection_Indicated,
      Read_Data_Register_Not_Empty,
      Transmission_Complete_Indicated,
      Transmit_Data_Register_Empty,
      Line_Break_Detection_Indicated,
      Clear_To_Send_Indicated);

   function Status (This : USART; Flag : USART_Status_Flag) return Boolean
     with Inline;

   procedure Clear_Status (This : in out USART; Flag : USART_Status_Flag)
     with Inline;

   procedure Enable_DMA_Transmit_Requests (This : in out USART) with
     Inline,
     Post => DMA_Transmit_Requests_Enabled (This);

   procedure Disable_DMA_Transmit_Requests (This : in out USART) with
     Inline,
     Post => not DMA_Transmit_Requests_Enabled (This);

   function DMA_Transmit_Requests_Enabled  (This : USART) return Boolean with
     Inline;

   procedure Enable_DMA_Receive_Requests (This : in out USART) with
     Inline,
     Post => DMA_Receive_Requests_Enabled (This);

   procedure Disable_DMA_Receive_Requests (This : in out USART) with
     Inline,
     Post => not DMA_Receive_Requests_Enabled (This);

   function DMA_Receive_Requests_Enabled  (This : USART) return Boolean with
     Inline;

   procedure Pause_DMA_Transmission (This : in out USART)
     renames Disable_DMA_Transmit_Requests;

   procedure Resume_DMA_Transmission (This : in out USART) with
     Inline,
     Post => DMA_Transmit_Requests_Enabled (This) and
             Enabled (This);

   procedure Pause_DMA_Reception (This : in out USART)
     renames Disable_DMA_Receive_Requests;

   procedure Resume_DMA_Reception (This : in out USART) with
     Inline,
     Post => DMA_Receive_Requests_Enabled (This) and
             Enabled (This);

   function Data_Register_Address (This : USART) return System.Address with
     Inline;
   --  Returns the address of the USART Data Register. This is exported
   --  STRICTLY for the sake of clients driving a USART via DMA. All other
   --  clients of this package should use the procedural interfaces Transmit
   --  and Receive instead of directly accessing the Data Register!
   --  Seriously, don't use this function otherwise.

   -----------------------------
   -- HAL.UART implementation --
   -----------------------------

   overriding
   function Data_Size (This : USART) return HAL.UART.UART_Data_Size;

   overriding
   procedure Transmit
     (Port    : in out USART;
      Data    : UART_Data_8b;
      Status  : out UART_Status;
      Timeout : Natural := 1000)
     with
       Pre'Class => Data_Size (Port) = Data_Size_8b;

   overriding
   procedure Transmit
     (Port    : in out USART;
      Data    : UART_Data_9b;
      Status  : out UART_Status;
      Timeout : Natural := 1000)
     with
       Pre'Class => Data_Size (Port) = Data_Size_9b;

   overriding
   procedure Receive
     (Port    : in out USART;
      Data    : out UART_Data_8b;
      Status  : out UART_Status;
      Timeout : Natural := 1000)
     with
       Pre'Class => Data_Size (Port) = Data_Size_8b;

   overriding
   procedure Receive
     (Port    : in out USART;
      Data    : out UART_Data_9b;
      Status  : out UART_Status;
      Timeout : Natural := 1000)
     with
       Pre'Class => Data_Size (Port) = Data_Size_9b;

private

   function APB_Clock (This : USART) return Word with Inline;
   --  Returns either APB1 or APB2 clock rate, in Hertz, depending on the
   --  USART. For the sake of not making this package board-specific, we assume
   --  that we are given a valid USART object at a valid address, AND that the
   --  USART devices really are configured such that only 1 and 6 are on APB2.
   --  Therefore, if a board has additional USARTs beyond USART6, eg USART8 on
   --  the F429I Discovery board, they better conform to that assumption.
   --  See Note # 2 in each of Tables 139-141 of the RM on pages 970 - 972.

   type Internal_USART is new STM32_SVD.USART.USART2_Peripheral;
   type USART (Periph : not null access Internal_USART) is
     limited new HAL.UART.UART_Port with null record;

end STM32.USARTs;

remove No_Elaboration_Code restriction

STM32.USART: remove No_Elaboration_Code restriction


--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2016 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.

with Ada.Characters.Latin_1;
with Ada.Strings.Fixed;

with GL.Debug;

with Orka.Strings;
with Orka.Terminals;

package body Orka.Rendering.Programs.Modules is

   use GL.Debug;
   package Messages is new GL.Debug.Messages (Third_Party, Other);

   function Trim_Image (Value : Integer) return String is
     (Orka.Strings.Trim (Integer'Image (Value)));

   package L1 renames Ada.Characters.Latin_1;

   use Orka.Strings;

   procedure Log_Error_With_Source (Text, Info_Log, Message : String) is
      package SF renames Ada.Strings.Fixed;

      Extra_Rows          : constant := 1;
      Line_Number_Padding : constant := 2;

      Separator : constant String := " | ";

      use SF;

      use all type Orka.Terminals.Color;
      use all type Orka.Terminals.Style;
   begin
      declare
         Log_Parts : constant Orka.Strings.String_List := Split (Info_Log, ":", 3);

         Message_Parts : constant String_List := Split (Trim (+Log_Parts (3)), ": ", 2);

         Message_Kind_Color : constant Orka.Terminals.Color :=
           (if +Message_Parts (1) = "error" then
              Red
            elsif +Message_Parts (1) = "warning" then
              Yellow
            elsif +Message_Parts (1) = "note" then
              Cyan
            else
              Default);

         Message_Kind : constant String :=
           Orka.Terminals.Colorize (+Message_Parts (1) & ":", Foreground => Message_Kind_Color);
         Message_Value : constant String :=
           Orka.Terminals.Colorize (+Message_Parts (2), Attribute => Bold);

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

         Lines : constant Orka.Strings.String_List := Orka.Strings.Split (Text, "" & L1.LF);

         Error_Row : constant Positive :=
           Positive'Value (+Orka.Strings.Split (+Log_Parts (2), "(", 2) (1));
         First_Row : constant Positive := Positive'Max (Lines'First, Error_Row - Extra_Rows);
         Last_Row  : constant Positive := Positive'Min (Lines'Last, Error_Row + Extra_Rows);

         Line_Digits : constant Positive := Trim (Last_Row'Image)'Length + Line_Number_Padding;
      begin
         Messages.Log (High, Message);

         for Row_Index in First_Row .. Last_Row loop
            declare
               Row_Image : constant String :=
                 SF.Tail (Trim (Row_Index'Image), Line_Digits);
               Row_Image_Colorized : constant String :=
                  Orka.Terminals.Colorize (Row_Image, Attribute => Dark);

               Line_Image : constant String := +Lines (Row_Index);

               First_Index_Line : constant Natural :=
                 SF.Index_Non_Blank (Line_Image, Going => Ada.Strings.Forward);
               Last_Index_Line : constant Natural :=
                 SF.Index_Non_Blank (Line_Image, Going => Ada.Strings.Backward);

               Error_Indicator : constant String :=
                 Orka.Terminals.Colorize
                   (Natural'Max (0, First_Index_Line - 1) * " " &
                    (Last_Index_Line - First_Index_Line + 1) * "^",
                    Foreground => Green,
                    Attribute  => Bold);

               Prefix_Image : constant String :=
                 (Row_Image'Length + Separator'Length) * " ";
            begin
               Messages.Log (High, Row_Image_Colorized  & Separator & Line_Image);
               if Row_Index = Error_Row then
                  Messages.Log (High, Prefix_Image  & Error_Indicator);
                  Messages.Log (High, Prefix_Image & ">>> " & Message_Kind & " " & Message_Value);
               end if;
            end;
         end loop;
      end;
   exception
      when others =>
         --  Continue if parsing Info_Log fails
         null;
   end Log_Error_With_Source;

   procedure Load_And_Compile
     (Object      : in out Module;
      Shader_Kind : GL.Objects.Shaders.Shader_Type;
      Location    : Resources.Locations.Location_Ptr;
      Path        : String) is
   begin
      if Path /= "" then
         pragma Assert (Object.Shaders (Shader_Kind).Is_Empty);
         declare
            Shader : GL.Objects.Shaders.Shader (Kind => Shader_Kind);
            Source : constant Resources.Byte_Array_Pointers.Pointer
              := Location.Read_Data (Path);

            Text : String renames Resources.Convert (Source.Get);
         begin
            Shader.Set_Source (Text);

            Shader.Compile;
            if not Shader.Compile_Status then
               declare
                  Log : constant String := Shader.Info_Log;

                  Log_Parts : constant Orka.Strings.String_List := Split (Log, "" & L1.LF);
               begin
                  for Part of Log_Parts loop
                     Log_Error_With_Source (Text, +Part, "Compiling shader " & Path & " failed:");
                  end loop;

                  raise Shader_Compile_Error with Path & ":" & Log;
               end;
            end if;
            Messages.Log (Notification, "Compiled shader " & Path);
            Messages.Log (Notification, "  size: " & Trim_Image (Orka.Strings.Lines (Text)) &
              " lines (" & Trim_Image (Source.Get.Value'Length) & " bytes)");
            Messages.Log (Notification, "  kind: " & Shader_Kind'Image);

            Object.Shaders (Shader_Kind).Replace_Element (Shader);
         end;
      end if;
   end Load_And_Compile;

   procedure Set_And_Compile
     (Object      : in out Module;
      Shader_Kind : GL.Objects.Shaders.Shader_Type;
      Source      : String) is
   begin
      if Source /= "" then
         pragma Assert (Object.Shaders (Shader_Kind).Is_Empty);
         declare
            Shader : GL.Objects.Shaders.Shader (Kind => Shader_Kind);
         begin
            Shader.Set_Source (Source);

            Shader.Compile;
            if not Shader.Compile_Status then
               declare
                  Log : constant String := Shader.Info_Log;

                  Log_Parts : constant Orka.Strings.String_List := Split (Log, "" & L1.LF);
               begin
                  for Part of Log_Parts loop
                     Log_Error_With_Source (Source, +Part,
                       "Compiling " & Shader_Kind'Image & " shader failed:");
                  end loop;

                  raise Shader_Compile_Error with Shader_Kind'Image & ":" & Log;
               end;
            end if;
            Messages.Log (Notification, "Compiled string with " &
              Trim_Image (Source'Length) & " characters");
            Messages.Log (Notification, "  size: " &
              Trim_Image (Orka.Strings.Lines (Source)) & " lines");
            Messages.Log (Notification, "  kind: " & Shader_Kind'Image);

            Object.Shaders (Shader_Kind).Replace_Element (Shader);
         end;
      end if;
   end Set_And_Compile;

   function Create_Module_From_Sources (VS, TCS, TES, GS, FS, CS : String := "")
     return Module
   is
      use GL.Objects.Shaders;
   begin
      return Result : Module do
         Set_And_Compile (Result, Vertex_Shader, VS);
         Set_And_Compile (Result, Tess_Control_Shader, TCS);
         Set_And_Compile (Result, Tess_Evaluation_Shader, TES);
         Set_And_Compile (Result, Geometry_Shader, GS);
         Set_And_Compile (Result, Fragment_Shader, FS);
         Set_And_Compile (Result, Compute_Shader, CS);
      end return;
   end Create_Module_From_Sources;

   function Create_Module
     (Location : Resources.Locations.Location_Ptr;
      VS, TCS, TES, GS, FS, CS : String := "") return Module
   is
      use GL.Objects.Shaders;
   begin
      return Result : Module do
         Load_And_Compile (Result, Vertex_Shader, Location, VS);
         Load_And_Compile (Result, Tess_Control_Shader, Location, TCS);
         Load_And_Compile (Result, Tess_Evaluation_Shader, Location, TES);
         Load_And_Compile (Result, Geometry_Shader, Location, GS);
         Load_And_Compile (Result, Fragment_Shader, Location, FS);
         Load_And_Compile (Result, Compute_Shader, Location, CS);
      end return;
   end Create_Module;

   procedure Attach_Shaders (Modules : Module_Array; Program : in out Programs.Program) is
      use GL.Objects.Shaders;

      procedure Attach (Subject : Module; Stage : GL.Objects.Shaders.Shader_Type) is
         Holder : Shader_Holder.Holder renames Subject.Shaders (Stage);
      begin
         if not Holder.Is_Empty then
            Program.GL_Program.Attach (Holder.Element);
         end if;
      end Attach;
   begin
      for Module of Modules loop
         Attach (Module, Vertex_Shader);
         Attach (Module, Tess_Control_Shader);
         Attach (Module, Tess_Evaluation_Shader);
         Attach (Module, Geometry_Shader);
         Attach (Module, Fragment_Shader);
         Attach (Module, Compute_Shader);
      end loop;
   end Attach_Shaders;

   procedure Detach_Shaders (Modules : Module_Array; Program : Programs.Program) is
      use GL.Objects.Shaders;

      procedure Detach (Holder : Shader_Holder.Holder) is
      begin
         if not Holder.Is_Empty then
            Program.GL_Program.Detach (Holder.Element);
         end if;
      end Detach;
   begin
      for Module of Modules loop
         Detach (Module.Shaders (Vertex_Shader));
         Detach (Module.Shaders (Tess_Control_Shader));
         Detach (Module.Shaders (Tess_Evaluation_Shader));
         Detach (Module.Shaders (Geometry_Shader));
         Detach (Module.Shaders (Fragment_Shader));
         Detach (Module.Shaders (Compute_Shader));
      end loop;
   end Detach_Shaders;

end Orka.Rendering.Programs.Modules;

--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2016 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.

with Ada.Characters.Latin_1;
with Ada.Strings.Fixed;

with Orka.Logging;
with Orka.Strings;
with Orka.Terminals;

package body Orka.Rendering.Programs.Modules is

   use all type Orka.Logging.Source;
   use all type Orka.Logging.Severity;

   package Messages is new Orka.Logging.Messages (Shader_Compiler);

   function Trim_Image (Value : Integer) return String is
     (Orka.Strings.Trim (Integer'Image (Value)));

   package L1 renames Ada.Characters.Latin_1;

   use Orka.Strings;

   procedure Log_Error_With_Source (Text, Info_Log, Message : String) is
      package SF renames Ada.Strings.Fixed;

      Extra_Rows          : constant := 1;
      Line_Number_Padding : constant := 2;

      Separator : constant String := " | ";

      use SF;

      use all type Orka.Terminals.Color;
      use all type Orka.Terminals.Style;
   begin
      declare
         Log_Parts : constant Orka.Strings.String_List := Split (Info_Log, ":", 3);

         Message_Parts : constant String_List := Split (Trim (+Log_Parts (3)), ": ", 2);

         Message_Kind_Color : constant Orka.Terminals.Color :=
           (if +Message_Parts (1) = "error" then
              Red
            elsif +Message_Parts (1) = "warning" then
              Yellow
            elsif +Message_Parts (1) = "note" then
              Cyan
            else
              Default);

         Message_Kind : constant String :=
           Orka.Terminals.Colorize (+Message_Parts (1) & ":", Foreground => Message_Kind_Color);
         Message_Value : constant String :=
           Orka.Terminals.Colorize (+Message_Parts (2), Attribute => Bold);

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

         Lines : constant Orka.Strings.String_List := Orka.Strings.Split (Text, "" & L1.LF);

         Error_Row : constant Positive :=
           Positive'Value (+Orka.Strings.Split (+Log_Parts (2), "(", 2) (1));
         First_Row : constant Positive := Positive'Max (Lines'First, Error_Row - Extra_Rows);
         Last_Row  : constant Positive := Positive'Min (Lines'Last, Error_Row + Extra_Rows);

         Line_Digits : constant Positive := Trim (Last_Row'Image)'Length + Line_Number_Padding;
      begin
         Messages.Log (Error, Message);

         for Row_Index in First_Row .. Last_Row loop
            declare
               Row_Image : constant String :=
                 SF.Tail (Trim (Row_Index'Image), Line_Digits);
               Row_Image_Colorized : constant String :=
                  Orka.Terminals.Colorize (Row_Image, Attribute => Dark);

               Line_Image : constant String := +Lines (Row_Index);

               First_Index_Line : constant Natural :=
                 SF.Index_Non_Blank (Line_Image, Going => Ada.Strings.Forward);
               Last_Index_Line : constant Natural :=
                 SF.Index_Non_Blank (Line_Image, Going => Ada.Strings.Backward);

               Error_Indicator : constant String :=
                 Orka.Terminals.Colorize
                   (Natural'Max (0, First_Index_Line - 1) * " " &
                    (Last_Index_Line - First_Index_Line + 1) * "^",
                    Foreground => Green,
                    Attribute  => Bold);

               Prefix_Image : constant String :=
                 (Row_Image'Length + Separator'Length) * " ";
            begin
               Messages.Log (Error, Row_Image_Colorized  & Separator & Line_Image);
               if Row_Index = Error_Row then
                  Messages.Log (Error, Prefix_Image  & Error_Indicator);
                  Messages.Log (Error, Prefix_Image & ">>> " & Message_Kind & " " & Message_Value);
               end if;
            end;
         end loop;
      end;
   exception
      when others =>
         --  Continue if parsing Info_Log fails
         null;
   end Log_Error_With_Source;

   procedure Load_And_Compile
     (Object      : in out Module;
      Shader_Kind : GL.Objects.Shaders.Shader_Type;
      Location    : Resources.Locations.Location_Ptr;
      Path        : String) is
   begin
      if Path /= "" then
         pragma Assert (Object.Shaders (Shader_Kind).Is_Empty);
         declare
            Shader : GL.Objects.Shaders.Shader (Kind => Shader_Kind);
            Source : constant Resources.Byte_Array_Pointers.Pointer
              := Location.Read_Data (Path);

            Text : String renames Resources.Convert (Source.Get);
         begin
            Shader.Set_Source (Text);

            Shader.Compile;
            if not Shader.Compile_Status then
               declare
                  Log : constant String := Shader.Info_Log;

                  Log_Parts : constant Orka.Strings.String_List := Split (Log, "" & L1.LF);
               begin
                  for Part of Log_Parts loop
                     Log_Error_With_Source (Text, +Part, "Compiling shader " & Path & " failed:");
                  end loop;

                  raise Shader_Compile_Error with Path & ":" & Log;
               end;
            end if;
            Messages.Log (Debug, "Compiled shader " & Path);
            Messages.Log (Debug, "  size: " & Trim_Image (Orka.Strings.Lines (Text)) &
              " lines (" & Trim_Image (Source.Get.Value'Length) & " bytes)");
            Messages.Log (Debug, "  kind: " & Shader_Kind'Image);

            Object.Shaders (Shader_Kind).Replace_Element (Shader);
         end;
      end if;
   end Load_And_Compile;

   procedure Set_And_Compile
     (Object      : in out Module;
      Shader_Kind : GL.Objects.Shaders.Shader_Type;
      Source      : String) is
   begin
      if Source /= "" then
         pragma Assert (Object.Shaders (Shader_Kind).Is_Empty);
         declare
            Shader : GL.Objects.Shaders.Shader (Kind => Shader_Kind);
         begin
            Shader.Set_Source (Source);

            Shader.Compile;
            if not Shader.Compile_Status then
               declare
                  Log : constant String := Shader.Info_Log;

                  Log_Parts : constant Orka.Strings.String_List := Split (Log, "" & L1.LF);
               begin
                  for Part of Log_Parts loop
                     Log_Error_With_Source (Source, +Part,
                       "Compiling " & Shader_Kind'Image & " shader failed:");
                  end loop;

                  raise Shader_Compile_Error with Shader_Kind'Image & ":" & Log;
               end;
            end if;
            Messages.Log (Debug, "Compiled string with " &
              Trim_Image (Source'Length) & " characters");
            Messages.Log (Debug, "  size: " &
              Trim_Image (Orka.Strings.Lines (Source)) & " lines");
            Messages.Log (Debug, "  kind: " & Shader_Kind'Image);

            Object.Shaders (Shader_Kind).Replace_Element (Shader);
         end;
      end if;
   end Set_And_Compile;

   function Create_Module_From_Sources (VS, TCS, TES, GS, FS, CS : String := "")
     return Module
   is
      use GL.Objects.Shaders;
   begin
      return Result : Module do
         Set_And_Compile (Result, Vertex_Shader, VS);
         Set_And_Compile (Result, Tess_Control_Shader, TCS);
         Set_And_Compile (Result, Tess_Evaluation_Shader, TES);
         Set_And_Compile (Result, Geometry_Shader, GS);
         Set_And_Compile (Result, Fragment_Shader, FS);
         Set_And_Compile (Result, Compute_Shader, CS);
      end return;
   end Create_Module_From_Sources;

   function Create_Module
     (Location : Resources.Locations.Location_Ptr;
      VS, TCS, TES, GS, FS, CS : String := "") return Module
   is
      use GL.Objects.Shaders;
   begin
      return Result : Module do
         Load_And_Compile (Result, Vertex_Shader, Location, VS);
         Load_And_Compile (Result, Tess_Control_Shader, Location, TCS);
         Load_And_Compile (Result, Tess_Evaluation_Shader, Location, TES);
         Load_And_Compile (Result, Geometry_Shader, Location, GS);
         Load_And_Compile (Result, Fragment_Shader, Location, FS);
         Load_And_Compile (Result, Compute_Shader, Location, CS);
      end return;
   end Create_Module;

   procedure Attach_Shaders (Modules : Module_Array; Program : in out Programs.Program) is
      use GL.Objects.Shaders;

      procedure Attach (Subject : Module; Stage : GL.Objects.Shaders.Shader_Type) is
         Holder : Shader_Holder.Holder renames Subject.Shaders (Stage);
      begin
         if not Holder.Is_Empty then
            Program.GL_Program.Attach (Holder.Element);
         end if;
      end Attach;
   begin
      for Module of Modules loop
         Attach (Module, Vertex_Shader);
         Attach (Module, Tess_Control_Shader);
         Attach (Module, Tess_Evaluation_Shader);
         Attach (Module, Geometry_Shader);
         Attach (Module, Fragment_Shader);
         Attach (Module, Compute_Shader);
      end loop;
   end Attach_Shaders;

   procedure Detach_Shaders (Modules : Module_Array; Program : Programs.Program) is
      use GL.Objects.Shaders;

      procedure Detach (Holder : Shader_Holder.Holder) is
      begin
         if not Holder.Is_Empty then
            Program.GL_Program.Detach (Holder.Element);
         end if;
      end Detach;
   begin
      for Module of Modules loop
         Detach (Module.Shaders (Vertex_Shader));
         Detach (Module.Shaders (Tess_Control_Shader));
         Detach (Module.Shaders (Tess_Evaluation_Shader));
         Detach (Module.Shaders (Geometry_Shader));
         Detach (Module.Shaders (Fragment_Shader));
         Detach (Module.Shaders (Compute_Shader));
      end loop;
   end Detach_Shaders;

end Orka.Rendering.Programs.Modules;

orka: Use Orka.Logging instead of GL.Debug to log errors in shaders

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