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

with DOM.Core;
with Gen.Model.Packages;
with Gen.Model.XMI;

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

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

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

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

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

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

private

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

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

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

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

end Gen.Artifacts.XMI;

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

with DOM.Core;
with Gen.Model.Packages;
with Gen.Model.XMI;

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

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

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

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

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

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

private

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

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

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

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

end Gen.Artifacts.XMI;

Add the use foreign key stereotype

Add the use foreign key stereotype


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

with Util.Log.Loggers;
with MAT.Readers.Marshaller;
package body MAT.Readers.Streams is

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

   MAX_MSG_SIZE : constant Ada.Streams.Stream_Element_Offset := 2048;

   --  ------------------------------
   --  Read a message from the stream.
   --  ------------------------------
   overriding
   procedure Read_Message (Reader : in out Stream_Reader_Type;
                           Msg    : in out Message) is
      use type Ada.Streams.Stream_Element_Offset;

      Buffer : constant Util.Streams.Buffered.Buffer_Access := Msg.Buffer.Buffer;
      Last   : Ada.Streams.Stream_Element_Offset;
   begin
      Reader.Stream.Read (Buffer (0 .. 1), Last);
      if Last /= 2 then
         raise Ada.IO_Exceptions.End_Error;
      end if;
      Msg.Buffer.Size := 2;
      Msg.Buffer.Current := Msg.Buffer.Start;
      Msg.Size := Natural (MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer));
      if Msg.Size < 2 then
         Log.Error ("Invalid message size {0}", Natural'Image (Msg.Size));
      end if;
      if Ada.Streams.Stream_Element_Offset (Msg.Size) >= Buffer'Last then
         Log.Error ("Message size {0} is too big", Natural'Image (Msg.Size));
         raise Ada.IO_Exceptions.Data_Error;
      end if;
      Reader.Stream.Read (Buffer (0 .. Ada.Streams.Stream_Element_Offset (Msg.Size - 1)), Last);
      Msg.Buffer.Current := Msg.Buffer.Start;
      Msg.Buffer.Last    := Buffer (Last)'Address;
      Msg.Buffer.Size    := Msg.Size;
   end Read_Message;

   --  ------------------------------
   --  Read the events from the stream and stop when the end of the stream is reached.
   --  ------------------------------
   procedure Read_All (Reader : in out Stream_Reader_Type) is
      use Ada.Streams;
      use type MAT.Types.Uint8;

      Buffer  : aliased Buffer_Type;
      Msg     : Message;
      Last    : Ada.Streams.Stream_Element_Offset;
      Format  : MAT.Types.Uint8;
   begin
      Reader.Data := new Ada.Streams.Stream_Element_Array (0 .. MAX_MSG_SIZE);
      Msg.Buffer := Buffer'Unchecked_Access;
      Msg.Buffer.Start := Reader.Data (0)'Address;
      Msg.Buffer.Current := Msg.Buffer.Start;
      Msg.Buffer.Last := Reader.Data (MAX_MSG_SIZE)'Address;
      Msg.Buffer.Size := 3;
      Buffer.Buffer := Reader.Data;
      Reader.Stream.Read (Reader.Data (0 .. 2), Last);
      Format := MAT.Readers.Marshaller.Get_Uint8 (Msg.Buffer);
      if Format = 0 then
         Msg.Buffer.Endian := LITTLE_ENDIAN;
         Log.Debug ("Data stream is little endian");
      else
         Msg.Buffer.Endian := BIG_ENDIAN;
         Log.Debug ("Data stream is big endian");
      end if;
      Reader.Read_Message (Msg);
      Reader.Read_Headers (Msg);
      while not Reader.Stream.Is_Eof loop
         Reader.Read_Message (Msg);
         Reader.Dispatch_Message (Msg);
      end loop;
   end Read_All;

end MAT.Readers.Streams;

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

with Util.Log.Loggers;
with MAT.Readers.Marshaller;
package body MAT.Readers.Streams is

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

   MAX_MSG_SIZE : constant Ada.Streams.Stream_Element_Offset := 2048;

   --  ------------------------------
   --  Read a message from the stream.
   --  ------------------------------
   overriding
   procedure Read_Message (Reader : in out Stream_Reader_Type;
                           Msg    : in out Message) is
      use type Ada.Streams.Stream_Element_Offset;

      Buffer : constant Util.Streams.Buffered.Buffer_Access := Msg.Buffer.Buffer;
      Last   : Ada.Streams.Stream_Element_Offset;
   begin
      Reader.Stream.Read (Buffer (0 .. 1), Last);
      if Last /= 2 then
         raise Ada.IO_Exceptions.End_Error;
      end if;
      Msg.Buffer.Size := 2;
      Msg.Buffer.Current := Msg.Buffer.Start;
      Msg.Size := Natural (MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer));
      if Msg.Size < 2 then
         Log.Error ("Invalid message size {0}", Natural'Image (Msg.Size));
      end if;
      if Ada.Streams.Stream_Element_Offset (Msg.Size) >= Buffer'Last then
         Log.Error ("Message size {0} is too big", Natural'Image (Msg.Size));
         raise Ada.IO_Exceptions.Data_Error;
      end if;
      Reader.Stream.Read (Buffer (0 .. Ada.Streams.Stream_Element_Offset (Msg.Size - 1)), Last);
      Msg.Buffer.Current := Msg.Buffer.Start;
      Msg.Buffer.Last    := Buffer (Last)'Address;
      Msg.Buffer.Size    := Msg.Size;
      Log.Debug ("Read message size {0}", Natural'Image (Msg.Size));
   end Read_Message;

   --  ------------------------------
   --  Read the events from the stream and stop when the end of the stream is reached.
   --  ------------------------------
   procedure Read_All (Reader : in out Stream_Reader_Type) is
      use Ada.Streams;
      use type MAT.Types.Uint8;

      Buffer  : aliased Buffer_Type;
      Msg     : Message;
      Last    : Ada.Streams.Stream_Element_Offset;
      Format  : MAT.Types.Uint8;
   begin
      Reader.Data := new Ada.Streams.Stream_Element_Array (0 .. MAX_MSG_SIZE);
      Msg.Buffer := Buffer'Unchecked_Access;
      Msg.Buffer.Start := Reader.Data (0)'Address;
      Msg.Buffer.Current := Msg.Buffer.Start;
      Msg.Buffer.Last := Reader.Data (MAX_MSG_SIZE)'Address;
      Buffer.Buffer := Reader.Data;
      Reader.Stream.Read (Reader.Data (0 .. 0), Last);
      Format := MAT.Readers.Marshaller.Get_Uint8 (Msg.Buffer);
      if Format = 0 then
         Msg.Buffer.Endian := LITTLE_ENDIAN;
         Log.Debug ("Data stream is little endian");
      else
         Msg.Buffer.Endian := BIG_ENDIAN;
         Log.Debug ("Data stream is big endian");
      end if;
      Reader.Read_Message (Msg);
      Reader.Read_Headers (Msg);
      while not Reader.Stream.Is_Eof loop
         Reader.Read_Message (Msg);
         Reader.Dispatch_Message (Msg);
      end loop;
   end Read_All;

end MAT.Readers.Streams;

Fix reading the header of event probe streams


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

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

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

   MSG_BEGIN  : constant MAT.Events.Internal_Reference := 0;
   MSG_END    : constant MAT.Events.Internal_Reference := 1;

   M_PID      : constant MAT.Events.Internal_Reference := 1;
   M_EXE      : constant MAT.Events.Internal_Reference := 2;

   PID_NAME   : aliased constant String := "pid";
   EXE_NAME   : aliased constant String := "exe";

   Process_Attributes : aliased constant MAT.Events.Attribute_Table :=
     (1 => (Name => PID_NAME'Access, Size => 0,
            Kind => MAT.Events.T_SIZE_T, Ref => M_PID),
      2 => (Name => EXE_NAME'Access, Size => 0,
            Kind => MAT.Events.T_FRAME, Ref => M_EXE));

   --  ------------------------------
   --  Create a new process after the begin event is received from the event stream.
   --  ------------------------------
   procedure Create_Process (For_Servant : in out Process_Servant;
                             Pid         : in MAT.Types.Target_Process_Ref) is
   begin
      For_Servant.Target.Create_Process (Pid     => Pid,
                                         Process => For_Servant.Process);
      MAT.Memory.Targets.Initialize (Memory => For_Servant.Process.Memory,
                                     Reader => For_Servant.Reader.all);
   end Create_Process;

   procedure Probe_Begin (For_Servant : in out Process_Servant;
                          Id          : in MAT.Events.Internal_Reference;
                          Defs        : in MAT.Events.Attribute_Table;
                          Frame       : in MAT.Events.Frame_Info;
                          Msg         : in out MAT.Readers.Message) is
      Pid  : MAT.Types.Target_Process_Ref := 0;
      Path : Ada.Strings.Unbounded.Unbounded_String;
   begin
      for I in Defs'Range loop
         declare
            Def : MAT.Events.Attribute renames Defs (I);
         begin
            case Def.Ref is
               when M_PID =>
                  Pid := MAT.Readers.Marshaller.Get_Target_Size (Msg.Buffer, Def.Kind);

               when M_EXE =>
                  Path := MAT.Readers.Marshaller.Get_String (Msg.Buffer);

               when others =>
                  MAT.Readers.Marshaller.Skip (Msg.Buffer, Def.Size);
            end case;
         end;
      end loop;
      For_Servant.Create_Process (Pid);
      For_Servant.Reader.Read_Message (Msg);
      For_Servant.Reader.Read_Event_Definitions (Msg);
   end Probe_Begin;

   overriding
   procedure Dispatch (For_Servant : in out Process_Servant;
                       Id          : in MAT.Events.Internal_Reference;
                       Params      : in MAT.Events.Const_Attribute_Table_Access;
                       Frame       : in MAT.Events.Frame_Info;
                       Msg         : in out MAT.Readers.Message) is
   begin
      case Id is
         when MSG_BEGIN =>
            For_Servant.Probe_Begin (Id, Params.all, Frame, Msg);

         when MSG_END =>
            null;

         when others =>
            null;

      end case;
   end Dispatch;

   --  ------------------------------
   --  Register the reader to extract and analyze process events.
   --  ------------------------------
   procedure Register (Into   : in out MAT.Readers.Manager_Base'Class;
                       Reader : in Process_Reader_Access) is
   begin
      Reader.Reader := Into'Unchecked_Access;
      Into.Register_Reader (Reader.all'Access, "begin", MSG_BEGIN,
                            Process_Attributes'Access);
      Into.Register_Reader (Reader.all'Access, "end", MSG_END,
                            Process_Attributes'Access);
   end Register;

   --  ------------------------------
   --  Initialize the target object to prepare for reading process events.
   --  ------------------------------
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Readers.Manager_Base'Class) is
      Process_Reader : constant Process_Reader_Access
        := new Process_Servant;
   begin
      Process_Reader.Target := Target'Unrestricted_Access;
      Register (Reader, Process_Reader);
   end Initialize;

end MAT.Targets.Readers;

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

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

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

   MSG_BEGIN  : constant MAT.Events.Internal_Reference := 0;
   MSG_END    : constant MAT.Events.Internal_Reference := 1;

   M_PID      : constant MAT.Events.Internal_Reference := 1;
   M_EXE      : constant MAT.Events.Internal_Reference := 2;

   PID_NAME   : aliased constant String := "pid";
   EXE_NAME   : aliased constant String := "exe";

   Process_Attributes : aliased constant MAT.Events.Attribute_Table :=
     (1 => (Name => PID_NAME'Access, Size => 0,
            Kind => MAT.Events.T_SIZE_T, Ref => M_PID),
      2 => (Name => EXE_NAME'Access, Size => 0,
            Kind => MAT.Events.T_FRAME, Ref => M_EXE));

   --  ------------------------------
   --  Create a new process after the begin event is received from the event stream.
   --  ------------------------------
   procedure Create_Process (For_Servant : in out Process_Servant;
                             Pid         : in MAT.Types.Target_Process_Ref;
                             Path        : in Ada.Strings.Unbounded.Unbounded_String) is
   begin
      For_Servant.Target.Create_Process (Pid     => Pid,
                                         Path    => Path,
                                         Process => For_Servant.Process);
      MAT.Memory.Targets.Initialize (Memory => For_Servant.Process.Memory,
                                     Reader => For_Servant.Reader.all);
   end Create_Process;

   procedure Probe_Begin (For_Servant : in out Process_Servant;
                          Id          : in MAT.Events.Internal_Reference;
                          Defs        : in MAT.Events.Attribute_Table;
                          Frame       : in MAT.Events.Frame_Info;
                          Msg         : in out MAT.Readers.Message) is
      Pid  : MAT.Types.Target_Process_Ref := 0;
      Path : Ada.Strings.Unbounded.Unbounded_String;
   begin
      for I in Defs'Range loop
         declare
            Def : MAT.Events.Attribute renames Defs (I);
         begin
            case Def.Ref is
               when M_PID =>
                  Pid := MAT.Readers.Marshaller.Get_Target_Size (Msg.Buffer, Def.Kind);

               when M_EXE =>
                  Path := MAT.Readers.Marshaller.Get_String (Msg.Buffer);

               when others =>
                  MAT.Readers.Marshaller.Skip (Msg.Buffer, Def.Size);
            end case;
         end;
      end loop;
      For_Servant.Create_Process (Pid, Path);
      For_Servant.Reader.Read_Message (Msg);
      For_Servant.Reader.Read_Event_Definitions (Msg);
   end Probe_Begin;

   overriding
   procedure Dispatch (For_Servant : in out Process_Servant;
                       Id          : in MAT.Events.Internal_Reference;
                       Params      : in MAT.Events.Const_Attribute_Table_Access;
                       Frame       : in MAT.Events.Frame_Info;
                       Msg         : in out MAT.Readers.Message) is
   begin
      case Id is
         when MSG_BEGIN =>
            For_Servant.Probe_Begin (Id, Params.all, Frame, Msg);

         when MSG_END =>
            null;

         when others =>
            null;

      end case;
   end Dispatch;

   --  ------------------------------
   --  Register the reader to extract and analyze process events.
   --  ------------------------------
   procedure Register (Into   : in out MAT.Readers.Manager_Base'Class;
                       Reader : in Process_Reader_Access) is
   begin
      Reader.Reader := Into'Unchecked_Access;
      Into.Register_Reader (Reader.all'Access, "begin", MSG_BEGIN,
                            Process_Attributes'Access);
      Into.Register_Reader (Reader.all'Access, "end", MSG_END,
                            Process_Attributes'Access);
   end Register;

   --  ------------------------------
   --  Initialize the target object to prepare for reading process events.
   --  ------------------------------
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Readers.Manager_Base'Class) is
      Process_Reader : constant Process_Reader_Access
        := new Process_Servant;
   begin
      Process_Reader.Target := Target'Unrestricted_Access;
      Register (Reader, Process_Reader);
   end Initialize;

end MAT.Targets.Readers;

Update the Create_Process procedure call to add the executable path


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

with FE310.Time; use FE310.Time;
with FE310_SVD.CLINT; use FE310_SVD.CLINT;
with FE310_SVD.OTP_Mem; use FE310_SVD.OTP_Mem;
with FE310_SVD.PRIC; use FE310_SVD.PRIC;
with FE310_SVD.SPI; use FE310_SVD.SPI;

package body FE310 is

   Crystal_Frequency : constant := 16_000_000;
   HFROSC_Frequency : constant := 72_000_000;  -- High frequency internal oscillator

   -------------------
   -- CPU_Frequency --
   -------------------

   function CPU_Frequency return UInt32 is
      Freq : UInt32;
   begin
      if PRIC_Periph.PLLCFG.SEL = Internal then
         Freq := HFROSC_Frequency / (UInt32 (PRIC_Periph.HFROSCCFG.DIV) + 1);
      else
         if PRIC_Periph.PLLCFG.REFSEL = Crystal then
            Freq := Crystal_Frequency;
         else
            Freq := HFROSC_Frequency;
         end if;

         if PRIC_Periph.PLLCFG.BYPASS = False then
            Freq := Freq / (UInt32 (PRIC_Periph.PLLCFG.R) + 1)
              * (2 * (UInt32 (PRIC_Periph.PLLCFG.F) + 1))
              / (2**(Natural (PRIC_Periph.PLLCFG.Q)));
         end if;

         if PRIC_Periph.PLLOUTDIV.DIV_BY_1 = False then
               Freq := Freq / (2 * (UInt32 (PRIC_Periph.PLLOUTDIV.DIV) + 1));
         end if;
      end if;

      return Freq;
   end CPU_Frequency;

   -----------------------------------------
   -- Load_Internal_Oscilator_Calibration --
   -----------------------------------------

   procedure Load_Internal_Oscilator_Calibration is
   begin
      PRIC_Periph.HFROSCCFG.TRIM := OTP_Mem_Periph.HFROSC_TRIM.VALUE - 1;
   end Load_Internal_Oscilator_Calibration;

   ----------------------------
   -- Use_Crystal_Oscillator --
   ----------------------------

   procedure Use_Crystal_Oscillator (Divider : PLL_Output_Divider := 1) is
   begin
      --  Use internal oscillator during switch
      PRIC_Periph.HFROSCCFG.DIV := 4;  --  Divide by 5, Freq = 14.4 MHz
      PRIC_Periph.HFROSCCFG.ENABLE := True;
      loop
         exit when PRIC_Periph.HFROSCCFG.READY;
      end loop;
      PRIC_Periph.PLLCFG.SEL := Internal;

      --  Start the crystal oscillator
      PRIC_Periph.HFXOSCCFG.ENABLE := True;
      loop
         exit when PRIC_Periph.HFXOSCCFG.READY;
      end loop;

      --  Configure the final divider
      if Divider = 1 then
         PRIC_Periph.PLLOUTDIV.DIV_BY_1 := True;
      else
         PRIC_Periph.PLLOUTDIV.DIV_BY_1 := False;
         PRIC_Periph.PLLOUTDIV.DIV := PLLOUTDIV_DIV_Field ((Divider / 2) - 1);
      end if;

      --  Switch to crystal oscillator
      PRIC_Periph.PLLCFG.REFSEL := Crystal;
      PRIC_Periph.PLLCFG.BYPASS := True;
      PRIC_Periph.PLLCFG.SEL := Pll;

      --  Disable internal oscillator
      PRIC_Periph.HFROSCCFG.ENABLE := False;
   end Use_Crystal_Oscillator;

   -----------------------------
   -- Use_Internal_Oscillator --
   -----------------------------

   procedure Use_Internal_Oscillator (Divider : Internal_Oscillator_Divider := 5) is
   begin
      PRIC_Periph.HFROSCCFG.DIV := HFROSCCFG_DIV_Field (Divider - 1);
      PRIC_Periph.HFROSCCFG.ENABLE := True;
      loop
         exit when PRIC_Periph.HFROSCCFG.READY;
      end loop;
      PRIC_Periph.PLLCFG.SEL := Internal;

      --  Disable crystal oscillator and PLL
      PRIC_Periph.HFXOSCCFG.ENABLE := False;
      PRIC_Periph.PLLCFG.BYPASS := True;
   end Use_Internal_Oscillator;

   ------------
   -- Use_PLL--
   ------------

   procedure Use_PLL (Reference : PLL_Reference;
                      Internal_Osc_Div : Internal_Oscillator_Divider  := 5;
                      R_Div : PLL_R;
                      F_Mul : PLL_F;
                      Q_Div : PLL_Q;
                      Output_Div : PLL_Output_Divider) is
   begin
      --  Use internal oscillator during switch
      PRIC_Periph.HFROSCCFG.DIV := HFROSCCFG_DIV_Field (Internal_Osc_Div - 1);
      PRIC_Periph.HFROSCCFG.ENABLE := True;
      loop
         exit when PRIC_Periph.HFROSCCFG.READY;
      end loop;
      PRIC_Periph.PLLCFG.SEL := Internal;

      if Reference = Crystal then
         --  Start the crystal oscillator
         PRIC_Periph.HFXOSCCFG.ENABLE := True;
         loop
            exit when PRIC_Periph.HFXOSCCFG.READY;
         end loop;
      else
         PRIC_Periph.HFXOSCCFG.ENABLE := False;
      end if;

      --  Configure the PLL
      PRIC_Periph.PLLCFG.REFSEL := PLLCFG_REFSEL_Field (Reference);
      PRIC_Periph.PLLCFG.R := PLLCFG_R_Field (R_Div - 1);
      PRIC_Periph.PLLCFG.F := PLLCFG_F_Field ((F_Mul / 2) - 1);
      PRIC_Periph.PLLCFG.Q := PLLCFG_Q_Field (PLL_Q'Enum_Rep (Q_Div));

      --  Configure the final divider
      if Output_Div = 1 then
         PRIC_Periph.PLLOUTDIV.DIV_BY_1 := True;
      else
         PRIC_Periph.PLLOUTDIV.DIV_BY_1 := False;
         PRIC_Periph.PLLOUTDIV.DIV := PLLOUTDIV_DIV_Field ((Output_Div / 2) - 1);
      end if;

      --  Start the PLL
      PRIC_Periph.PLLCFG.BYPASS := False;
      Delay_Us (150);

      loop
         exit when PRIC_Periph.PLLCFG.LOCK;
      end loop;

      --  Switch to PLL
      PRIC_Periph.PLLCFG.SEL := Pll;

      --  Disable internal oscillator if the crystal reference is used
      if Reference = Crystal then
         PRIC_Periph.HFROSCCFG.ENABLE := False;
      end if;

   end Use_PLL;

   ---------------------------------
   -- Set_SPI_Flash_Clock_Divider --
   ---------------------------------

   procedure Set_SPI_Flash_Clock_Divider (Divider : SPI_Clock_Divider) is
   begin
      QSPI0_Periph.SCKDIV.SCALE := (UInt12 (Divider) / 2) - 1;
   end Set_SPI_Flash_Clock_Divider;

   -----------------------------
   -- SPI_Flash_Clock_Divider --
   -----------------------------

   function SPI_Flash_Clock_Divider return SPI_Clock_Divider is
   begin
      return 2 * (Integer (QSPI0_Periph.SCKDIV.SCALE) + 1);
   end SPI_Flash_Clock_Divider;

end FE310;

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

with FE310.Time;        use FE310.Time;
with FE310_SVD.OTP_Mem; use FE310_SVD.OTP_Mem;
with FE310_SVD.PRIC;    use FE310_SVD.PRIC;
with FE310_SVD.SPI;     use FE310_SVD.SPI;

package body FE310 is

   Crystal_Frequency : constant := 16_000_000;
   HFROSC_Frequency : constant := 72_000_000;  -- High frequency internal oscillator

   -------------------
   -- CPU_Frequency --
   -------------------

   function CPU_Frequency return UInt32 is
      Freq : UInt32;
   begin
      if PRIC_Periph.PLLCFG.SEL = Internal then
         Freq := HFROSC_Frequency / (UInt32 (PRIC_Periph.HFROSCCFG.DIV) + 1);
      else
         if PRIC_Periph.PLLCFG.REFSEL = Crystal then
            Freq := Crystal_Frequency;
         else
            Freq := HFROSC_Frequency;
         end if;

         if PRIC_Periph.PLLCFG.BYPASS = False then
            Freq := Freq / (UInt32 (PRIC_Periph.PLLCFG.R) + 1)
              * (2 * (UInt32 (PRIC_Periph.PLLCFG.F) + 1))
              / (2**(Natural (PRIC_Periph.PLLCFG.Q)));
         end if;

         if PRIC_Periph.PLLOUTDIV.DIV_BY_1 = False then
               Freq := Freq / (2 * (UInt32 (PRIC_Periph.PLLOUTDIV.DIV) + 1));
         end if;
      end if;

      return Freq;
   end CPU_Frequency;

   -----------------------------------------
   -- Load_Internal_Oscilator_Calibration --
   -----------------------------------------

   procedure Load_Internal_Oscilator_Calibration is
   begin
      PRIC_Periph.HFROSCCFG.TRIM := OTP_Mem_Periph.HFROSC_TRIM.VALUE - 1;
   end Load_Internal_Oscilator_Calibration;

   ----------------------------
   -- Use_Crystal_Oscillator --
   ----------------------------

   procedure Use_Crystal_Oscillator (Divider : PLL_Output_Divider := 1) is
   begin
      --  Use internal oscillator during switch
      PRIC_Periph.HFROSCCFG.DIV := 4;  --  Divide by 5, Freq = 14.4 MHz
      PRIC_Periph.HFROSCCFG.ENABLE := True;
      loop
         exit when PRIC_Periph.HFROSCCFG.READY;
      end loop;
      PRIC_Periph.PLLCFG.SEL := Internal;

      --  Start the crystal oscillator
      PRIC_Periph.HFXOSCCFG.ENABLE := True;
      loop
         exit when PRIC_Periph.HFXOSCCFG.READY;
      end loop;

      --  Configure the final divider
      if Divider = 1 then
         PRIC_Periph.PLLOUTDIV.DIV_BY_1 := True;
      else
         PRIC_Periph.PLLOUTDIV.DIV_BY_1 := False;
         PRIC_Periph.PLLOUTDIV.DIV := PLLOUTDIV_DIV_Field ((Divider / 2) - 1);
      end if;

      --  Switch to crystal oscillator
      PRIC_Periph.PLLCFG.REFSEL := Crystal;
      PRIC_Periph.PLLCFG.BYPASS := True;
      PRIC_Periph.PLLCFG.SEL := Pll;

      --  Disable internal oscillator
      PRIC_Periph.HFROSCCFG.ENABLE := False;
   end Use_Crystal_Oscillator;

   -----------------------------
   -- Use_Internal_Oscillator --
   -----------------------------

   procedure Use_Internal_Oscillator (Divider : Internal_Oscillator_Divider := 5) is
   begin
      PRIC_Periph.HFROSCCFG.DIV := HFROSCCFG_DIV_Field (Divider - 1);
      PRIC_Periph.HFROSCCFG.ENABLE := True;
      loop
         exit when PRIC_Periph.HFROSCCFG.READY;
      end loop;
      PRIC_Periph.PLLCFG.SEL := Internal;

      --  Disable crystal oscillator and PLL
      PRIC_Periph.HFXOSCCFG.ENABLE := False;
      PRIC_Periph.PLLCFG.BYPASS := True;
   end Use_Internal_Oscillator;

   ------------
   -- Use_PLL--
   ------------

   procedure Use_PLL (Reference : PLL_Reference;
                      Internal_Osc_Div : Internal_Oscillator_Divider  := 5;
                      R_Div : PLL_R;
                      F_Mul : PLL_F;
                      Q_Div : PLL_Q;
                      Output_Div : PLL_Output_Divider) is
   begin
      --  Use internal oscillator during switch
      PRIC_Periph.HFROSCCFG.DIV := HFROSCCFG_DIV_Field (Internal_Osc_Div - 1);
      PRIC_Periph.HFROSCCFG.ENABLE := True;
      loop
         exit when PRIC_Periph.HFROSCCFG.READY;
      end loop;
      PRIC_Periph.PLLCFG.SEL := Internal;

      if Reference = Crystal then
         --  Start the crystal oscillator
         PRIC_Periph.HFXOSCCFG.ENABLE := True;
         loop
            exit when PRIC_Periph.HFXOSCCFG.READY;
         end loop;
      else
         PRIC_Periph.HFXOSCCFG.ENABLE := False;
      end if;

      --  Configure the PLL
      PRIC_Periph.PLLCFG.REFSEL := PLLCFG_REFSEL_Field (Reference);
      PRIC_Periph.PLLCFG.R := PLLCFG_R_Field (R_Div - 1);
      PRIC_Periph.PLLCFG.F := PLLCFG_F_Field ((F_Mul / 2) - 1);
      PRIC_Periph.PLLCFG.Q := PLLCFG_Q_Field (PLL_Q'Enum_Rep (Q_Div));

      --  Configure the final divider
      if Output_Div = 1 then
         PRIC_Periph.PLLOUTDIV.DIV_BY_1 := True;
      else
         PRIC_Periph.PLLOUTDIV.DIV_BY_1 := False;
         PRIC_Periph.PLLOUTDIV.DIV := PLLOUTDIV_DIV_Field ((Output_Div / 2) - 1);
      end if;

      --  Start the PLL
      PRIC_Periph.PLLCFG.BYPASS := False;
      Delay_Us (150);

      loop
         exit when PRIC_Periph.PLLCFG.LOCK;
      end loop;

      --  Switch to PLL
      PRIC_Periph.PLLCFG.SEL := Pll;

      --  Disable internal oscillator if the crystal reference is used
      if Reference = Crystal then
         PRIC_Periph.HFROSCCFG.ENABLE := False;
      end if;

   end Use_PLL;

   ---------------------------------
   -- Set_SPI_Flash_Clock_Divider --
   ---------------------------------

   procedure Set_SPI_Flash_Clock_Divider (Divider : SPI_Clock_Divider) is
   begin
      QSPI0_Periph.SCKDIV.SCALE := (UInt12 (Divider) / 2) - 1;
   end Set_SPI_Flash_Clock_Divider;

   -----------------------------
   -- SPI_Flash_Clock_Divider --
   -----------------------------

   function SPI_Flash_Clock_Divider return SPI_Clock_Divider is
   begin
      return 2 * (Integer (QSPI0_Periph.SCKDIV.SCALE) + 1);
   end SPI_Flash_Clock_Divider;

end FE310;

Remove useless with

FE310: Remove useless with


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

with Util.Beans.Objects;
with Util.Serialize.Mappers.Record_Mapper;
with Util.Serialize.Mappers.Vector_Mapper;
with Util.Serialize.Mappers;
with Ada.Containers.Vectors;
with Util.Serialize.Contexts;
package Mapping is

   use Ada.Strings.Unbounded;

   type Property is record
      Name     : Unbounded_String;
      Value    : Unbounded_String;
   end record;

   type Address is record
      City      : Unbounded_String;
      Street    : Unbounded_String;
      Country   : Unbounded_String;
      Zip       : Natural := 0;
      Info      : Property;
   end record;

   type Person is record
      Name       : Unbounded_String;
      First_Name : Unbounded_String;
      Last_Name  : Unbounded_String;
      Username   : Unbounded_String;
      Gender     : Unbounded_String;
      Link       : Unbounded_String;
      Age        : Natural := 0;
      Addr       : Address;
      Id         : Long_Long_Integer := 0;
   end record;

   type Person_Access is access all Person;

   type Person_Fields is (FIELD_FIRST_NAME, FIELD_LAST_NAME, FIELD_AGE,
                          FIELD_NAME, FIELD_USER_NAME, FIELD_GENDER,
                          FIELD_LINK, FIELD_ID);

   --  Set the name/value pair on the current object.
   procedure Set_Member (P     : in out Person;
                         Field : in Person_Fields;
                         Value : in Util.Beans.Objects.Object);

   function Get_Person_Member (From  : in Person;
                               Field : in Person_Fields) return Util.Beans.Objects.Object;

   package Person_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Person,
                                               Element_Type_Access => Person_Access,
                                               Fields              => Person_Fields,
                                               Set_Member          => Set_Member);

   subtype Person_Context is Person_Mapper.Element_Data;

   package Person_Vector is
     new Ada.Containers.Vectors (Element_Type => Person,
                                 Index_Type   => Natural);

   package Person_Vector_Mapper is
     new Util.Serialize.Mappers.Vector_Mapper (Vectors        => Person_Vector,
                                               Element_Mapper => Person_Mapper);

   subtype Person_Vector_Context is Person_Vector_Mapper.Vector_Data;

   --  Get the address mapper which describes how to load an Address.
   function Get_Address_Mapper return Util.Serialize.Mappers.Mapper_Access;

   --  Get the person mapper which describes how to load a Person.
   function Get_Person_Mapper return Person_Mapper.Mapper_Access;

   --  Get the person vector mapper which describes how to load a list of Person.
   function Get_Person_Vector_Mapper return Person_Vector_Mapper.Mapper_Access;

end Mapping;

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

with Util.Beans.Objects;
with Util.Serialize.Mappers.Record_Mapper;
with Util.Serialize.Mappers;
with Ada.Containers.Vectors;
package Mapping is

   use Ada.Strings.Unbounded;

   type Property is record
      Name     : Unbounded_String;
      Value    : Unbounded_String;
   end record;

   type Address is record
      City      : Unbounded_String;
      Street    : Unbounded_String;
      Country   : Unbounded_String;
      Zip       : Natural := 0;
      Info      : Property;
   end record;

   type Person is record
      Name       : Unbounded_String;
      First_Name : Unbounded_String;
      Last_Name  : Unbounded_String;
      Username   : Unbounded_String;
      Gender     : Unbounded_String;
      Link       : Unbounded_String;
      Age        : Natural := 0;
      Addr       : Address;
      Id         : Long_Long_Integer := 0;
   end record;

   type Person_Access is access all Person;

   type Person_Fields is (FIELD_FIRST_NAME, FIELD_LAST_NAME, FIELD_AGE,
                          FIELD_NAME, FIELD_USER_NAME, FIELD_GENDER,
                          FIELD_LINK, FIELD_ID);

   --  Set the name/value pair on the current object.
   procedure Set_Member (P     : in out Person;
                         Field : in Person_Fields;
                         Value : in Util.Beans.Objects.Object);

   function Get_Person_Member (From  : in Person;
                               Field : in Person_Fields) return Util.Beans.Objects.Object;

   package Person_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Person,
                                               Element_Type_Access => Person_Access,
                                               Fields              => Person_Fields,
                                               Set_Member          => Set_Member);

   subtype Person_Context is Person_Mapper.Element_Data;

   package Person_Vector is
     new Ada.Containers.Vectors (Element_Type => Person,
                                 Index_Type   => Natural);

   --  Get the address mapper which describes how to load an Address.
   function Get_Address_Mapper return Util.Serialize.Mappers.Mapper_Access;

   --  Get the person mapper which describes how to load a Person.
   function Get_Person_Mapper return Person_Mapper.Mapper_Access;

end Mapping;

Remove the Person_Vector_Mapper instantiation so that we don't depend on the Vector_Mapper generic package


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

--  The Util.Encodes.HMAC.SHA256 package generates HMAC-SHA256 authentication
--  (See RFC 2104 - HMAC: Keyed-Hashing for Message Authentication).
package Util.Encoders.HMAC.SHA256 is

   HASH_SIZE : constant := Util.Encoders.SHA256.HASH_SIZE;

   --  Sign the data string with the key and return the HMAC-SHA256 code in binary.
   function Sign (Key  : in String;
                  Data : in String) return Util.Encoders.SHA256.Hash_Array;

   --  Sign the data string with the key and return the HMAC-SHA256 code as hexadecimal string.
   function Sign (Key  : in String;
                  Data : in String) return Util.Encoders.SHA256.Digest;

   --  Sign the data array with the key and return the HMAC-SHA256 code in the result.
   procedure Sign (Key    : in Ada.Streams.Stream_Element_Array;
                   Data   : in Ada.Streams.Stream_Element_Array;
                   Result : out Util.Encoders.SHA256.Hash_Array);

   --  Sign the data string with the key and return the HMAC-SHA256 code as base64 string.
   --  When URL is True, use the base64 URL alphabet to encode in base64.
   function Sign_Base64 (Key  : in String;
                         Data : in String;
                         URL  : in Boolean := False) return Util.Encoders.SHA256.Base64_Digest;

   --  ------------------------------
   --  HMAC-SHA256 Context
   --  ------------------------------
   type Context is limited private;

   --  Set the hmac private key.  The key must be set before calling any Update
   --  procedure.
   procedure Set_Key (E   : in out Context;
                      Key : in String);

   --  Set the hmac private key.  The key must be set before calling any Update
   --  procedure.
   procedure Set_Key (E   : in out Context;
                      Key : in Ada.Streams.Stream_Element_Array);

   --  Update the hash with the string.
   procedure Update (E : in out Context;
                     S : in String);

   --  Update the hash with the string.
   procedure Update (E : in out Context;
                     S : in Ada.Streams.Stream_Element_Array);

   --  Computes the HMAC-SHA256 with the private key and the data collected by
   --  the Update procedures.  Returns the raw binary hash in Hash.
   procedure Finish (E    : in out Context;
                     Hash : out Util.Encoders.SHA256.Hash_Array);

   --  Computes the HMAC-SHA256 with the private key and the data collected by
   --  the Update procedures.  Returns the hexadecimal hash in Hash.
   procedure Finish (E    : in out Context;
                     Hash : out Util.Encoders.SHA256.Digest);

   --  Computes the HMAC-SHA256 with the private key and the data collected by
   --  the Update procedures.  Returns the base64 hash in Hash.
   --  When URL is True, use the base64 URL alphabet to encode in base64.
   procedure Finish_Base64 (E    : in out Context;
                            Hash : out Util.Encoders.SHA256.Base64_Digest;
                            URL  : in Boolean := False);

private

   type Context is new Ada.Finalization.Limited_Controlled with record
      SHA     : Util.Encoders.SHA256.Context;
      Key     : Ada.Streams.Stream_Element_Array (0 .. 63);
      Key_Len : Ada.Streams.Stream_Element_Offset;
   end record;

   --  Initialize the SHA-1 context.
   overriding
   procedure Initialize (E : in out Context);

end Util.Encoders.HMAC.SHA256;

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

--  The Util.Encodes.HMAC.SHA256 package generates HMAC-SHA256 authentication
--  (See RFC 2104 - HMAC: Keyed-Hashing for Message Authentication).
package Util.Encoders.HMAC.SHA256 is

   HASH_SIZE : constant := Util.Encoders.SHA256.HASH_SIZE;

   --  Sign the data string with the key and return the HMAC-SHA256 code in binary.
   function Sign (Key  : in String;
                  Data : in String) return Util.Encoders.SHA256.Hash_Array;

   --  Sign the data string with the key and return the HMAC-SHA256 code as hexadecimal string.
   function Sign (Key  : in String;
                  Data : in String) return Util.Encoders.SHA256.Digest;

   --  Sign the data array with the key and return the HMAC-SHA256 code in the result.
   procedure Sign (Key    : in Ada.Streams.Stream_Element_Array;
                   Data   : in Ada.Streams.Stream_Element_Array;
                   Result : out Util.Encoders.SHA256.Hash_Array);

   procedure Sign (Key    : in Secret_Key;
                   Data   : in Ada.Streams.Stream_Element_Array;
                   Result : out Util.Encoders.SHA256.Hash_Array);

   --  Sign the data string with the key and return the HMAC-SHA256 code as base64 string.
   --  When URL is True, use the base64 URL alphabet to encode in base64.
   function Sign_Base64 (Key  : in String;
                         Data : in String;
                         URL  : in Boolean := False) return Util.Encoders.SHA256.Base64_Digest;

   --  ------------------------------
   --  HMAC-SHA256 Context
   --  ------------------------------
   type Context is limited private;

   --  Set the hmac private key.  The key must be set before calling any Update
   --  procedure.
   procedure Set_Key (E   : in out Context;
                      Key : in String);

   --  Set the hmac private key.  The key must be set before calling any Update
   --  procedure.
   procedure Set_Key (E   : in out Context;
                      Key : in Ada.Streams.Stream_Element_Array);

   --  Update the hash with the string.
   procedure Update (E : in out Context;
                     S : in String);

   --  Update the hash with the string.
   procedure Update (E : in out Context;
                     S : in Ada.Streams.Stream_Element_Array);

   --  Computes the HMAC-SHA256 with the private key and the data collected by
   --  the Update procedures.  Returns the raw binary hash in Hash.
   procedure Finish (E    : in out Context;
                     Hash : out Util.Encoders.SHA256.Hash_Array);

   --  Computes the HMAC-SHA256 with the private key and the data collected by
   --  the Update procedures.  Returns the hexadecimal hash in Hash.
   procedure Finish (E    : in out Context;
                     Hash : out Util.Encoders.SHA256.Digest);

   --  Computes the HMAC-SHA256 with the private key and the data collected by
   --  the Update procedures.  Returns the base64 hash in Hash.
   --  When URL is True, use the base64 URL alphabet to encode in base64.
   procedure Finish_Base64 (E    : in out Context;
                            Hash : out Util.Encoders.SHA256.Base64_Digest;
                            URL  : in Boolean := False);

private

   type Context is new Ada.Finalization.Limited_Controlled with record
      SHA     : Util.Encoders.SHA256.Context;
      Key     : Ada.Streams.Stream_Element_Array (0 .. 63);
      Key_Len : Ada.Streams.Stream_Element_Offset;
   end record;

   --  Initialize the SHA-1 context.
   overriding
   procedure Initialize (E : in out Context);

end Util.Encoders.HMAC.SHA256;

Add a Sign procedure that uses a Secret_Key for the Key parameter


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

with File_Operations;
with PortScan.Log;
with Parameters;
with Unix;
with Ada.Characters.Latin_1;
with Ada.Directories;
with Ada.Exceptions;

package body PortScan.Tests is

   package FOP renames File_Operations;
   package LOG renames PortScan.Log;
   package PM  renames Parameters;
   package LAT renames Ada.Characters.Latin_1;
   package DIR renames Ada.Directories;
   package EX  renames Ada.Exceptions;

   --------------------------------------------------------------------------------------------
   --  exec_phase_check_plist
   --------------------------------------------------------------------------------------------
   function exec_check_plist
     (specification : PSP.Portspecs;
      log_handle    : TIO.File_Type;
      phase_name    : String;
      seq_id        : port_id;
      rootdir       : String) return Boolean
   is
      passed_check : Boolean := True;
      namebase     : constant String := specification.get_namebase;
   begin
      directory_list.Clear;
      dossier_list.Clear;

      LOG.log_phase_begin (log_handle, phase_name);
      TIO.Put_Line (log_handle, "====> Checking for package manifest issues");

      if not ingest_manifests (specification, log_handle, seq_id, namebase, rootdir) then
         passed_check := False;
      end if;

      if orphaned_directories_detected (log_handle, namebase, rootdir) then
         passed_check := False;
      end if;

      if missing_directories_detected (log_handle) then
         passed_check := False;
      end if;

      if orphaned_files_detected (log_handle, namebase, rootdir) then
         passed_check := False;
      end if;

      if missing_files_detected (log_handle) then
         passed_check := False;
      end if;

      if passed_check then
         TIO.Put_Line (log_handle, "====> No manifest issues found");
      end if;

      LOG.log_phase_end (log_handle);
      return passed_check;
   end exec_check_plist;

   --------------------------------------------------------------------------------------------
   --  ingest_manifests
   --------------------------------------------------------------------------------------------
   function ingest_manifests
     (specification : PSP.Portspecs;
      log_handle    : TIO.File_Type;
      seq_id        : port_id;
      namebase      : String;
      rootdir       : String) return Boolean
   is
      procedure eat_plist (position : subpackage_crate.Cursor);

      result   : Boolean := True;

      procedure eat_plist (position : subpackage_crate.Cursor)
      is
         subpackage    : HT.Text := subpackage_crate.Element (position).subpackage;
         manifest_file : String := "/construction/" & namebase & "/.manifest." &
                         HT.USS (subpackage) & ".mktmp";
         contents      : String := FOP.get_file_contents (rootdir & manifest_file);
         identifier    : constant String := HT.USS (subpackage) & " manifest: ";

         markers : HT.Line_Markers;
      begin
         HT.initialize_markers (contents, markers);
         loop
            exit when not HT.next_line_present (contents, markers);
            declare
               line      : constant String := HT.extract_line (contents, markers);
               line_text : HT.Text := HT.SUS (line);
               new_rec   : entry_record := (subpackage, False);
            begin
               if HT.leads (line, "@dir ") then
                  declare
                     dir      : String := line (line'First + 5 .. line'Last);
                     dir_text : HT.Text := HT.SUS (dir);
                  begin
                     if directory_list.Contains (dir_text) then
                        result := False;
                        declare
                           spkg : String := HT.USS (dossier_list.Element (line_text).subpackage);
                        begin
                           if spkg /= "" then
                              TIO.Put_Line
                                (log_handle,
                                 "Redundant @dir symbol, " & identifier & dir &
                                   " will already be created by the " & spkg & " manifest");
                           else
                              TIO.Put_Line
                                (log_handle,
                                 "Redundant @dir symbol, " & identifier & dir &
                                   " will already be created by another manifest");
                           end if;
                        end;
                     else
                        directory_list.Insert (dir_text, new_rec);
                     end if;
                  end;
               else
                  declare
                     modline : String  := modify_file_if_necessary (line);
                     ml_text : HT.Text := HT.SUS (modline);
                  begin
                     if dossier_list.Contains (ml_text) then
                        result := False;
                        declare
                           spkg : String := HT.USS (dossier_list.Element (ml_text).subpackage);
                        begin
                           TIO.Put_Line
                             (log_handle,
                              "Duplicate file entry, " & identifier & modline &
                                " already present in " & spkg & " manifest");
                        end;
                     else
                        dossier_list.Insert (ml_text, new_rec);
                        declare
                           plistdir : String := DIR.Containing_Directory (modline);
                           dir_text : HT.Text := HT.SUS (plistdir);
                        begin
                           if not directory_list.Contains (dir_text) then
                              directory_list.Insert (dir_text, new_rec);
                           end if;
                        end;
                     end if;
                  end;
               end if;
            end;
         end loop;
      exception
         when issue : others =>
            TIO.Put_Line (log_handle, "check-plist error: " & EX.Exception_Message (issue));
      end eat_plist;
   begin
      all_ports (seq_id).subpackages.Iterate (eat_plist'Access);
      return result;
   end ingest_manifests;

   --------------------------------------------------------------------------------------------
   --  directory_excluded
   --------------------------------------------------------------------------------------------
   function directory_excluded (candidate : String) return Boolean
   is
      --  mandatory candidate has ${STAGEDIR}/ stripped (no leading slash)
      rawlbase  : constant String  := HT.USS (PM.configuration.dir_localbase);
      localbase : constant String  := rawlbase (rawlbase'First + 1 .. rawlbase'Last);
      lblen     : constant Natural := localbase'Length;
   begin
      if candidate = localbase then
         return True;
      end if;
      if not HT.leads (candidate, localbase & "/") then
         --  This should never happen
         return False;
      end if;

      declare
         shortcan : String := candidate (candidate'First + lblen + 1 .. candidate'Last);
      begin
         if shortcan = "bin" or else
           shortcan = "etc" or else
           shortcan = "etc/rc.d" or else
           shortcan = "include" or else
           shortcan = "lib" or else
           shortcan = "lib/pkgconfig" or else
           shortcan = "libdata" or else
           shortcan = "libexec" or else
           shortcan = "sbin" or else
           shortcan = "share" or else
           shortcan = "www"
         then
            return True;
         end if;
         if not HT.leads (shortcan, "share/") then
            return False;
         end if;
      end;

      declare
         shortcan : String := candidate (candidate'First + lblen + 7 .. candidate'Last);
      begin
         if shortcan = "doc" or else
           shortcan = "examples" or else
           shortcan = "info" or else
           shortcan = "locale" or else
           shortcan = "man" or else
           shortcan = "nls"
         then
            return True;
         end if;
         if shortcan'Length /= 8 or else
           not HT.leads (shortcan, "man/man")
         then
            return False;
         end if;
         case shortcan (shortcan'Last) is
            when '1' .. '9' | 'l' | 'n' => return True;
            when others => return False;
         end case;
      end;
   end directory_excluded;

   --------------------------------------------------------------------------------------------
   --  orphaned_directories_detected
   --------------------------------------------------------------------------------------------
   function orphaned_directories_detected
     (log_handle    : TIO.File_Type;
      namebase      : String;
      rootdir       : String) return Boolean
   is
      rawlbase  : constant String  := HT.USS (PM.configuration.dir_localbase);
      localbase : constant String  := rawlbase (rawlbase'First + 1 .. rawlbase'Last);
      stagedir  : String := rootdir & "/construction/" & namebase & "/stage";
      command   : String := rootdir & "/usr/bin/find " & stagedir & " -type d -printf " &
                  LAT.Quotation & "%P\n" & LAT.Quotation;
      status    : Integer;
      comres    : String := HT.USS (Unix.piped_command (command, status));
      markers   : HT.Line_Markers;
      lblen     : constant Natural := localbase'Length;
      result    : Boolean := False;
      errprefix : constant String := "Orphaned directory detected: ";
   begin
      if status /= 0 then
         TIO.Put_Line ("orphaned_directories_detected: command error: " & comres);
         return True;
      end if;
      HT.initialize_markers (comres, markers);
      loop
         exit when not HT.next_line_present (comres, markers);
         declare
            line      : constant String := HT.extract_line (comres, markers);
            line_text : HT.Text := HT.SUS (line);
         begin
            if line /= "" then
               if HT.leads (line, localbase) then
                  declare
                     plist_dir : HT.Text := HT.SUS (line (line'First + lblen + 1 .. line'Last));
                  begin
                     if directory_list.Contains (plist_dir) then
                        directory_list.Update_Element (Position => directory_list.Find (plist_dir),
                                                       Process  => mark_verified'Access);
                     else
                        if not directory_excluded (line) then
                           TIO.Put_Line (log_handle, errprefix & line);
                           result := True;
                        end if;
                     end if;
                  end;
               else
                  if directory_list.Contains (line_text) then
                     directory_list.Update_Element (Position => directory_list.Find (line_text),
                                                    Process  => mark_verified'Access);
                  else
                     TIO.Put_Line (log_handle, errprefix & line);
                     result := True;
                  end if;
               end if;
            end if;
         end;
      end loop;
      return result;
   end orphaned_directories_detected;

   --------------------------------------------------------------------------------------------
   --  mark_verified
   --------------------------------------------------------------------------------------------
   procedure mark_verified (key : HT.Text; Element : in out entry_record) is
   begin
      Element.verified := True;
   end mark_verified;

   --------------------------------------------------------------------------------------------
   --  missing_directories_detected
   --------------------------------------------------------------------------------------------
   function missing_directories_detected (log_handle : TIO.File_Type) return Boolean
   is
      procedure check (position : entry_crate.Cursor);

      result : Boolean := False;

      procedure check (position : entry_crate.Cursor)
      is
         rec       : entry_record renames entry_crate.Element (position);
         plist_dir : String := HT.USS (entry_crate.Key (position));
      begin
         if not rec.verified then
            TIO.Put_Line
              (log_handle,
               "Directory " & plist_dir & " listed on " & HT.USS (rec.subpackage) &
                 " manifest is not present in the stage directory.");
            result := True;
         end if;
      end check;
   begin
      directory_list.Iterate (check'Access);
      return result;
   end missing_directories_detected;

   --------------------------------------------------------------------------------------------
   --  missing_files_detected
   --------------------------------------------------------------------------------------------
   function missing_files_detected (log_handle : TIO.File_Type) return Boolean
   is
      procedure check (position : entry_crate.Cursor);

      result : Boolean := False;

      procedure check (position : entry_crate.Cursor)
      is
         rec        : entry_record renames entry_crate.Element (position);
         plist_file : String := HT.USS (entry_crate.Key (position));
      begin
         if not rec.verified then
            TIO.Put_Line
              (log_handle,
               "File " & plist_file & " listed on " & HT.USS (rec.subpackage) &
                 " manifest is not present in the stage directory.");
            result := True;
         end if;
      end check;
   begin
      dossier_list.Iterate (check'Access);
      return result;
   end missing_files_detected;

   --------------------------------------------------------------------------------------------
   --  orphaned_files_detected
   --------------------------------------------------------------------------------------------
   function orphaned_files_detected
     (log_handle    : TIO.File_Type;
      namebase      : String;
      rootdir       : String) return Boolean
   is
      rawlbase  : constant String  := HT.USS (PM.configuration.dir_localbase);
      localbase : constant String  := rawlbase (rawlbase'First + 1 .. rawlbase'Last);
      stagedir  : String := rootdir & "/construction/" & namebase & "/stage";
      command   : String := rootdir & "/usr/bin/find " & stagedir &
                  " \( -type f -o -type l \) -printf " &
                  LAT.Quotation & "%P\n" & LAT.Quotation;
      status    : Integer;
      comres    : String := HT.USS (Unix.piped_command (command, status));
      markers   : HT.Line_Markers;
      lblen     : constant Natural := localbase'Length;
      result    : Boolean := False;
      errprefix : constant String := "Orphaned file detected: ";
   begin
      if status /= 0 then
         TIO.Put_Line ("orphaned_files_detected: command error: " & comres);
         return True;
      end if;
      HT.initialize_markers (comres, markers);
      loop
         exit when not HT.next_line_present (comres, markers);
         declare
            line      : constant String := HT.extract_line (comres, markers);
            line_text : HT.Text := HT.SUS (line);
         begin
            if line /= "" then
               if HT.leads (line, localbase) then
                  declare
                     plist_file : HT.Text := HT.SUS (line (line'First + lblen + 1 .. line'Last));
                  begin
                     if dossier_list.Contains (plist_file) then
                        dossier_list.Update_Element (Position => dossier_list.Find (plist_file),
                                                     Process  => mark_verified'Access);
                     else
                        TIO.Put_Line (log_handle, errprefix & line);
                        result := True;
                     end if;
                  end;
               else
                  if dossier_list.Contains (line_text) then
                     dossier_list.Update_Element (Position => dossier_list.Find (line_text),
                                                  Process  => mark_verified'Access);
                  else
                     TIO.Put_Line (log_handle, errprefix & line);
                     result := True;
                  end if;
               end if;
            end if;
         end;
      end loop;
      return result;
   end orphaned_files_detected;

   --------------------------------------------------------------------------------------------
   --  modify_file_if_necessary
   --------------------------------------------------------------------------------------------
   function modify_file_if_necessary (original : String) return String
   is
      function strip_raw_localbase (wrkstr : String) return String;
      function strip_raw_localbase (wrkstr : String) return String
      is
         rawlbase : constant String  := HT.USS (PM.configuration.dir_localbase) & "/";
      begin
         if HT.leads (wrkstr, rawlbase) then
            return wrkstr (wrkstr'First + rawlbase'Length .. wrkstr'Last);
         else
            return wrkstr;
         end if;
      end strip_raw_localbase;
   begin
      if HT.leads (original, "@info ") then
         return strip_raw_localbase (original (original'First + 6 .. original 'Last));
      else
         return original;
      end if;
   end modify_file_if_necessary;

end PortScan.Tests;

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

with File_Operations;
with PortScan.Log;
with Parameters;
with Unix;
with Ada.Characters.Latin_1;
with Ada.Directories;
with Ada.Exceptions;

package body PortScan.Tests is

   package FOP renames File_Operations;
   package LOG renames PortScan.Log;
   package PM  renames Parameters;
   package LAT renames Ada.Characters.Latin_1;
   package DIR renames Ada.Directories;
   package EX  renames Ada.Exceptions;

   --------------------------------------------------------------------------------------------
   --  exec_phase_check_plist
   --------------------------------------------------------------------------------------------
   function exec_check_plist
     (specification : PSP.Portspecs;
      log_handle    : TIO.File_Type;
      phase_name    : String;
      seq_id        : port_id;
      rootdir       : String) return Boolean
   is
      passed_check : Boolean := True;
      namebase     : constant String := specification.get_namebase;
   begin
      directory_list.Clear;
      dossier_list.Clear;

      LOG.log_phase_begin (log_handle, phase_name);
      TIO.Put_Line (log_handle, "====> Checking for package manifest issues");

      if not ingest_manifests (specification, log_handle, seq_id, namebase, rootdir) then
         passed_check := False;
      end if;

      if orphaned_directories_detected (log_handle, namebase, rootdir) then
         passed_check := False;
      end if;

      if missing_directories_detected (log_handle) then
         passed_check := False;
      end if;

      if orphaned_files_detected (log_handle, namebase, rootdir) then
         passed_check := False;
      end if;

      if missing_files_detected (log_handle) then
         passed_check := False;
      end if;

      if passed_check then
         TIO.Put_Line (log_handle, "====> No manifest issues found");
      end if;

      LOG.log_phase_end (log_handle);
      return passed_check;
   end exec_check_plist;

   --------------------------------------------------------------------------------------------
   --  ingest_manifests
   --------------------------------------------------------------------------------------------
   function ingest_manifests
     (specification : PSP.Portspecs;
      log_handle    : TIO.File_Type;
      seq_id        : port_id;
      namebase      : String;
      rootdir       : String) return Boolean
   is
      procedure eat_plist (position : subpackage_crate.Cursor);
      procedure insert_directory (directory : String; subpackage : HT.Text);

      result   : Boolean := True;

      procedure insert_directory (directory : String; subpackage : HT.Text)
      is
         numsep : Natural := HT.count_char (directory, LAT.Solidus);
         canvas : HT.Text := HT.SUS (directory);
      begin
         for x in 1 .. numsep + 1 loop
            declare
               paint      : String := HT.USS (canvas);
               my_new_rec : entry_record := (subpackage, False);
            begin
               if paint /= "" then
                  if not directory_list.Contains (canvas) then
                     directory_list.Insert (canvas, my_new_rec);
                  end if;
                  canvas := HT.SUS (HT.head (paint, "/"));
               end if;
            end;
         end loop;
      end insert_directory;

      procedure eat_plist (position : subpackage_crate.Cursor)
      is
         subpackage    : HT.Text := subpackage_crate.Element (position).subpackage;
         manifest_file : String := "/construction/" & namebase & "/.manifest." &
                         HT.USS (subpackage) & ".mktmp";
         contents      : String := FOP.get_file_contents (rootdir & manifest_file);
         identifier    : constant String := HT.USS (subpackage) & " manifest: ";

         markers : HT.Line_Markers;
      begin
         HT.initialize_markers (contents, markers);
         loop
            exit when not HT.next_line_present (contents, markers);
            declare
               line      : constant String := HT.extract_line (contents, markers);
               line_text : HT.Text := HT.SUS (line);
               new_rec   : entry_record := (subpackage, False);
            begin
               if HT.leads (line, "@dir ") then
                  declare
                     dir      : String := line (line'First + 5 .. line'Last);
                     dir_text : HT.Text := HT.SUS (dir);
                  begin
                     if directory_list.Contains (dir_text) then
                        result := False;
                        declare
                           spkg : String := HT.USS (dossier_list.Element (line_text).subpackage);
                        begin
                           if spkg /= "" then
                              TIO.Put_Line
                                (log_handle,
                                 "Redundant @dir symbol, " & identifier & dir &
                                   " will already be created by the " & spkg & " manifest");
                           else
                              TIO.Put_Line
                                (log_handle,
                                 "Redundant @dir symbol, " & identifier & dir &
                                   " will already be created by another manifest");
                           end if;
                        end;
                     else
                        insert_directory (dir, subpackage);
                     end if;
                  end;
               else
                  declare
                     modline : String  := modify_file_if_necessary (line);
                     ml_text : HT.Text := HT.SUS (modline);
                  begin
                     if dossier_list.Contains (ml_text) then
                        result := False;
                        declare
                           spkg : String := HT.USS (dossier_list.Element (ml_text).subpackage);
                        begin
                           TIO.Put_Line
                             (log_handle,
                              "Duplicate file entry, " & identifier & modline &
                                " already present in " & spkg & " manifest");
                        end;
                     else
                        dossier_list.Insert (ml_text, new_rec);
                        declare
                           plistdir : String := DIR.Containing_Directory (modline);
                        begin
                           insert_directory (plistdir, subpackage);
                        end;
                     end if;
                  end;
               end if;
            end;
         end loop;
      exception
         when issue : others =>
            TIO.Put_Line (log_handle, "check-plist error: " & EX.Exception_Message (issue));
      end eat_plist;
   begin
      all_ports (seq_id).subpackages.Iterate (eat_plist'Access);
      return result;
   end ingest_manifests;

   --------------------------------------------------------------------------------------------
   --  directory_excluded
   --------------------------------------------------------------------------------------------
   function directory_excluded (candidate : String) return Boolean
   is
      --  mandatory candidate has ${STAGEDIR}/ stripped (no leading slash)
      rawlbase  : constant String  := HT.USS (PM.configuration.dir_localbase);
      localbase : constant String  := rawlbase (rawlbase'First + 1 .. rawlbase'Last);
      lblen     : constant Natural := localbase'Length;
   begin
      if candidate = localbase then
         return True;
      end if;
      if not HT.leads (candidate, localbase & "/") then
         --  This should never happen
         return False;
      end if;

      declare
         shortcan : String := candidate (candidate'First + lblen + 1 .. candidate'Last);
      begin
         if shortcan = "bin" or else
           shortcan = "etc" or else
           shortcan = "etc/rc.d" or else
           shortcan = "include" or else
           shortcan = "lib" or else
           shortcan = "lib/pkgconfig" or else
           shortcan = "libdata" or else
           shortcan = "libexec" or else
           shortcan = "sbin" or else
           shortcan = "share" or else
           shortcan = "www"
         then
            return True;
         end if;
         if not HT.leads (shortcan, "share/") then
            return False;
         end if;
      end;

      declare
         shortcan : String := candidate (candidate'First + lblen + 7 .. candidate'Last);
      begin
         if shortcan = "doc" or else
           shortcan = "examples" or else
           shortcan = "info" or else
           shortcan = "locale" or else
           shortcan = "man" or else
           shortcan = "nls"
         then
            return True;
         end if;
         if shortcan'Length /= 8 or else
           not HT.leads (shortcan, "man/man")
         then
            return False;
         end if;
         case shortcan (shortcan'Last) is
            when '1' .. '9' | 'l' | 'n' => return True;
            when others => return False;
         end case;
      end;
   end directory_excluded;

   --------------------------------------------------------------------------------------------
   --  orphaned_directories_detected
   --------------------------------------------------------------------------------------------
   function orphaned_directories_detected
     (log_handle    : TIO.File_Type;
      namebase      : String;
      rootdir       : String) return Boolean
   is
      rawlbase  : constant String  := HT.USS (PM.configuration.dir_localbase);
      localbase : constant String  := rawlbase (rawlbase'First + 1 .. rawlbase'Last);
      stagedir  : String := rootdir & "/construction/" & namebase & "/stage";
      command   : String := rootdir & "/usr/bin/find " & stagedir & " -type d -printf " &
                  LAT.Quotation & "%P\n" & LAT.Quotation;
      status    : Integer;
      comres    : String := HT.USS (Unix.piped_command (command, status));
      markers   : HT.Line_Markers;
      lblen     : constant Natural := localbase'Length;
      result    : Boolean := False;
      errprefix : constant String := "Orphaned directory detected: ";
   begin
      if status /= 0 then
         TIO.Put_Line ("orphaned_directories_detected: command error: " & comres);
         return True;
      end if;
      HT.initialize_markers (comres, markers);
      loop
         exit when not HT.next_line_present (comres, markers);
         declare
            line      : constant String := HT.extract_line (comres, markers);
            line_text : HT.Text := HT.SUS (line);
         begin
            if line /= "" then
               if HT.leads (line, localbase) then
                  declare
                     plist_dir : HT.Text := HT.SUS (line (line'First + lblen + 1 .. line'Last));
                  begin
                     if directory_list.Contains (plist_dir) then
                        directory_list.Update_Element (Position => directory_list.Find (plist_dir),
                                                       Process  => mark_verified'Access);
                     else
                        if not directory_excluded (line) then
                           TIO.Put_Line (log_handle, errprefix & line);
                           result := True;
                        end if;
                     end if;
                  end;
               else
                  if directory_list.Contains (line_text) then
                     directory_list.Update_Element (Position => directory_list.Find (line_text),
                                                    Process  => mark_verified'Access);
                  else
                     TIO.Put_Line (log_handle, errprefix & line);
                     result := True;
                  end if;
               end if;
            end if;
         end;
      end loop;
      return result;
   end orphaned_directories_detected;

   --------------------------------------------------------------------------------------------
   --  mark_verified
   --------------------------------------------------------------------------------------------
   procedure mark_verified (key : HT.Text; Element : in out entry_record) is
   begin
      Element.verified := True;
   end mark_verified;

   --------------------------------------------------------------------------------------------
   --  missing_directories_detected
   --------------------------------------------------------------------------------------------
   function missing_directories_detected (log_handle : TIO.File_Type) return Boolean
   is
      procedure check (position : entry_crate.Cursor);

      result : Boolean := False;

      procedure check (position : entry_crate.Cursor)
      is
         rec       : entry_record renames entry_crate.Element (position);
         plist_dir : String := HT.USS (entry_crate.Key (position));
      begin
         if not rec.verified then
            TIO.Put_Line
              (log_handle,
               "Directory " & plist_dir & " listed on " & HT.USS (rec.subpackage) &
                 " manifest is not present in the stage directory.");
            result := True;
         end if;
      end check;
   begin
      directory_list.Iterate (check'Access);
      return result;
   end missing_directories_detected;

   --------------------------------------------------------------------------------------------
   --  missing_files_detected
   --------------------------------------------------------------------------------------------
   function missing_files_detected (log_handle : TIO.File_Type) return Boolean
   is
      procedure check (position : entry_crate.Cursor);

      result : Boolean := False;

      procedure check (position : entry_crate.Cursor)
      is
         rec        : entry_record renames entry_crate.Element (position);
         plist_file : String := HT.USS (entry_crate.Key (position));
      begin
         if not rec.verified then
            TIO.Put_Line
              (log_handle,
               "File " & plist_file & " listed on " & HT.USS (rec.subpackage) &
                 " manifest is not present in the stage directory.");
            result := True;
         end if;
      end check;
   begin
      dossier_list.Iterate (check'Access);
      return result;
   end missing_files_detected;

   --------------------------------------------------------------------------------------------
   --  orphaned_files_detected
   --------------------------------------------------------------------------------------------
   function orphaned_files_detected
     (log_handle    : TIO.File_Type;
      namebase      : String;
      rootdir       : String) return Boolean
   is
      rawlbase  : constant String  := HT.USS (PM.configuration.dir_localbase);
      localbase : constant String  := rawlbase (rawlbase'First + 1 .. rawlbase'Last);
      stagedir  : String := rootdir & "/construction/" & namebase & "/stage";
      command   : String := rootdir & "/usr/bin/find " & stagedir &
                  " \( -type f -o -type l \) -printf " &
                  LAT.Quotation & "%P\n" & LAT.Quotation;
      status    : Integer;
      comres    : String := HT.USS (Unix.piped_command (command, status));
      markers   : HT.Line_Markers;
      lblen     : constant Natural := localbase'Length;
      result    : Boolean := False;
      errprefix : constant String := "Orphaned file detected: ";
   begin
      if status /= 0 then
         TIO.Put_Line ("orphaned_files_detected: command error: " & comres);
         return True;
      end if;
      HT.initialize_markers (comres, markers);
      loop
         exit when not HT.next_line_present (comres, markers);
         declare
            line      : constant String := HT.extract_line (comres, markers);
            line_text : HT.Text := HT.SUS (line);
         begin
            if line /= "" then
               if HT.leads (line, localbase) then
                  declare
                     plist_file : HT.Text := HT.SUS (line (line'First + lblen + 1 .. line'Last));
                  begin
                     if dossier_list.Contains (plist_file) then
                        dossier_list.Update_Element (Position => dossier_list.Find (plist_file),
                                                     Process  => mark_verified'Access);
                     else
                        TIO.Put_Line (log_handle, errprefix & line);
                        result := True;
                     end if;
                  end;
               else
                  if dossier_list.Contains (line_text) then
                     dossier_list.Update_Element (Position => dossier_list.Find (line_text),
                                                  Process  => mark_verified'Access);
                  else
                     TIO.Put_Line (log_handle, errprefix & line);
                     result := True;
                  end if;
               end if;
            end if;
         end;
      end loop;
      return result;
   end orphaned_files_detected;

   --------------------------------------------------------------------------------------------
   --  modify_file_if_necessary
   --------------------------------------------------------------------------------------------
   function modify_file_if_necessary (original : String) return String
   is
      function strip_raw_localbase (wrkstr : String) return String;
      function strip_raw_localbase (wrkstr : String) return String
      is
         rawlbase : constant String  := HT.USS (PM.configuration.dir_localbase) & "/";
      begin
         if HT.leads (wrkstr, rawlbase) then
            return wrkstr (wrkstr'First + rawlbase'Length .. wrkstr'Last);
         else
            return wrkstr;
         end if;
      end strip_raw_localbase;
   begin
      if HT.leads (original, "@info ") then
         return strip_raw_localbase (original (original'First + 6 .. original 'Last));
      else
         return original;
      end if;
   end modify_file_if_necessary;

end PortScan.Tests;

Fix plist-check false position

Fix plist-check false position

there was a case when a directory only contained directories (which
might themselves contain files) where the directories were falsely
marked as orphans.