libgpr2_24.0.0_eda3c693/src/lib/gpr2-project-definition.adb

--
--  Copyright (C) 2019-2023, AdaCore
--
--  SPDX-License-Identifier: Apache-2.0 WITH LLVM-Exception
--

with Ada.Characters.Handling;
with Ada.Strings.Fixed;
with Ada.Unchecked_Deallocation;
with GNAT.OS_Lib;

with GNATCOLL.OS.Dir;
with GNATCOLL.OS.Stat;

with GPR2.Containers;
with GPR2.Message;
with GPR2.Project.Attribute;
with GPR2.Project.Attribute_Index;
with GPR2.Project.Registry.Attribute;
with GPR2.Project.Registry.Pack;
with GPR2.Project.Tree;
with GPR2.Source_Info.Parser.Registry;
with GPR2.Source_Reference.Value;

package body GPR2.Project.Definition is

   use GNAT;

   package ACH renames Ada.Characters.Handling;
   package ASF renames Ada.Strings.Fixed;
   package PRA renames Project.Registry.Attribute;
   package PRP renames Project.Registry.Pack;
   package SR  renames GPR2.Source_Reference;

   ----------------------------------
   -- Check_Aggregate_Library_Dirs --
   ----------------------------------

   procedure Check_Aggregate_Library_Dirs (View : Project.View.Object) is
      procedure Process_Aggregate (Proj : Project.View.Object);
      --  Recursive procedure to check the aggregated projects, as they may
      --  also be aggregated library projects.

      -----------------------
      -- Process_Aggregate --
      -----------------------

      procedure Process_Aggregate (Proj : Project.View.Object) is
      begin
         if Proj.Kind = K_Aggregate_Library then
            for V of Get_RO (Proj).Aggregated loop
               if V.Kind not in K_Aggregate_Library | K_Configuration
                 | K_Abstract
                 and then View.Library_Ali_Directory = V.Object_Directory
               then
                  View.Tree.Log_Messages.Append
                    (Message.Create
                       (Level   => Message.Error,
                        Sloc    => SR.Value.Create
                          (Filename => View.Path_Name.Value,
                           Line     => 0,
                           Column   => 0,
                           Text     => ""),
                        Message =>
                          "aggregate library ALI directory cannot be shared " &
                          "with object directory of aggregated project """ &
                          String (V.Path_Name.Base_Name) & """"));
               elsif V.Is_Library
                 and then View.Library_Ali_Directory = V.Library_Directory
               then
                  View.Tree.Log_Messages.Append
                    (Message.Create
                       (Level   => Message.Error,
                        Sloc    => SR.Value.Create
                          (Filename => View.Path_Name.Value,
                           Line     => 0,
                           Column   => 0,
                           Text     => ""),
                        Message =>
                          "aggregate library ALI directory cannot be shared " &
                          "with library directory of aggregated project """ &
                          String (V.Path_Name.Base_Name) & """"));
               elsif V.Kind not in K_Aggregate_Library | K_Configuration
                 | K_Abstract
                 and then View.Library_Directory = V.Object_Directory
               then
                  View.Tree.Log_Messages.Append
                    (Message.Create
                       (Level   => Message.Error,
                        Sloc    => SR.Value.Create
                          (Filename => View.Path_Name.Value,
                           Line     => 0,
                           Column   => 0,
                           Text     => ""),
                        Message =>
                          "aggregate library directory cannot be shared " &
                          "with object directory of aggregated project """ &
                          String (V.Path_Name.Base_Name) & """"));
               elsif V.Is_Library
                 and then View.Library_Directory = V.Library_Directory
               then
                  View.Tree.Log_Messages.Append
                    (Message.Create
                       (Level   => Message.Error,
                        Sloc    => SR.Value.Create
                          (Filename => View.Path_Name.Value,
                           Line     => 0,
                           Column   => 0,
                           Text     => ""),
                        Message =>
                          "aggregate library directory cannot be shared " &
                          "with library directory of aggregated project """ &
                          String (V.Path_Name.Base_Name) & """"));
               end if;

               Process_Aggregate (V);

            end loop;
         end if;
      end Process_Aggregate;
   begin
      Process_Aggregate (View);
   end Check_Aggregate_Library_Dirs;

   --------------------------------
   -- Check_Excluded_Source_Dirs --
   --------------------------------

   procedure Check_Excluded_Source_Dirs (View : Project.View.Object)
   is
      function Exists
        (View_Path : Path_Name.Object;
         Val       : Value_Type) return Boolean;
      --  Check if Excluded_Source_Dirs attribute value exists on the path.
      --  The attribute value is considered as a relative path from the view
      --  directory. If there is no match we try to process it as an
      --  absolute value and we check the existence of the relative path
      --  between the two absolute paths.

      ------------
      -- Exists --
      ------------

      function Exists
        (View_Path : Path_Name.Object;
         Val       : Value_Type) return Boolean
      is
         Recursive : constant Boolean :=
                       Val'Length >= 2
                           and then Val (Val'Last - 1 .. Val'Last) = "**";
         Last      : constant Natural :=
                       (if Recursive then Val'Last - 2 else Val'Last);
         Dir_Val   : constant Value_Type := Val (Val'First .. Last);
      begin
         if Dir_Val'Length = 0 then
            return True;
         else
            declare
               Dir_Name     : constant GPR2.Path_Name.Object :=
                                GPR2.Path_Name.Create_Directory
                                  (Filename_Type (Dir_Val),
                                   View_Path.Name);
               Relative_Dir : constant Filename_Type :=
                                Dir_Name.Relative_Path
                                  (From => View_Path).Name;
            begin
               return View_Path.Compose (Relative_Dir, True).Exists;
            end;
         end if;
      end Exists;

   begin
      for V of View.Tree.Ordered_Views loop
         if V.Kind in With_Source_Dirs_Kind then
            declare
               V_Path : constant Path_Name.Object := V.Dir_Name;
               Attr   : constant Project.Attribute.Object :=
                          V.Attribute (PRA.Excluded_Source_Dirs);
            begin
               if Attr.Is_Defined then
                  for Val of Attr.Values loop
                     if not Exists (V_Path, Val.Text) then
                        View.Tree.Log_Messages.Append
                          (Message.Create
                             (Level   => Message.Error,
                              Sloc    => Val,
                              Message =>
                                """" & Val.Text &
                                """ is not a valid directory"));
                     end if;
                  end loop;
               end if;
            end;
         end if;
      end loop;
   end Check_Excluded_Source_Dirs;

   --------------------------
   -- Check_Package_Naming --
   --------------------------

   procedure Check_Package_Naming (View : Project.View.Object) is
      procedure Check_View (View : Project.View.Object);
      --  Checks in View tree Casing, Dot_Replacement and Suffix attributes
      --  values.

      ----------------
      -- Check_View --
      ----------------

      procedure Check_View (View : Project.View.Object) is

         package Suffix_Lang_Maps is
           new Ada.Containers.Indefinite_Hashed_Maps
             (Value_Type, Language_Id, Ada.Strings.Hash, "=");

         Suffix_Lang_Map : Suffix_Lang_Maps.Map;
         --  key=suffix value; value=first language registering suffix use
         --  map used to detect/report multiple use of a suffix.

         procedure Log_Error
           (Level     : Message.Level_Value;
            Msg       : String;
            Attribute : Project.Attribute.Object);
         --  log naming package's  attribute problem at 'Attribute' source ref

         procedure Check_Casing;
         --  check casing is in expected range

         procedure Check_Dot_Replacement;
         --  check dot_replacement is not illegal

         use type Project.Attribute.Object;

         procedure Check_Illegal_Suffix
           (Attribute_Name : Q_Attribute_Id;
            Language       : Language_Id;
            Attribute      : Project.Attribute.Object)
           with Pre => Attribute /= Project.Attribute.Undefined;
         --  check Spec_Suffix, Body_Suffix or Separate_Suffix is not illegal

         ------------------
         -- Check_Casing --
         ------------------

         procedure Check_Casing is
            Casing : Project.Attribute.Object;
         begin
            if View.Check_Attribute (PRA.Naming.Casing, Result => Casing)
              and then ACH.To_Lower (Casing.Value.Text) not in
              "lowercase" | "uppercase" | "mixedcase"
            then
               Log_Error (Message.Error, "invalid value for casing", Casing);
            end if;
         end Check_Casing;

         ---------------------------
         -- Check_Dot_Replacement --
         ---------------------------

         procedure Check_Dot_Replacement is
            Dot_Replacement : constant Project.Attribute.Object :=
                                View.Attribute (PRA.Naming.Dot_Replacement);
            Value           : constant String :=
                                Dot_Replacement.Value.Text;
            Not_OK          : Boolean := False;
            subtype Printable_ASCII is Character range '!' .. '~';
         begin
            --  It must not be empty
            --  It cannot start or end with an alphanumeric character
            --  It cannot be a single underscore
            --  It cannot start with an underscore followed by an alphanumeric
            --  It cannot contain a dot '.' unless the entire string is "."
            --  It cannot include a space or a char that is not printable ASCII

            if ACH.Is_Alphanumeric (Value (Value'First))
              or else ACH.Is_Alphanumeric (Value (Value'Last))
              or else (Value (Value'First) = '_'
                       and then (Value'Length = 1
                                 or else ACH.Is_Alphanumeric
                                   (Value (Value'First + 1))))
              or else (Value'Length > 1
                       and then ASF.Index
                         (Source => Value, Pattern => ".") > 0)
            then
               Not_OK := True;

            else
               for J in Value'Range loop
                  if not (Value (J) in Printable_ASCII) then
                     Not_OK := True;
                     exit;
                  end if;
               end loop;
            end if;

            if Not_OK then
               Log_Error
                 (Message.Error,
                  """" & Value & """ is illegal for Dot_Replacement",
                  Dot_Replacement);
            end if;
         end Check_Dot_Replacement;

         --------------------------
         -- Check_Illegal_Suffix --
         --------------------------

         procedure Check_Illegal_Suffix
           (Attribute_Name : Q_Attribute_Id;
            Language       : Language_Id;
            Attribute      : Project.Attribute.Object)
         is
            Value    : constant Value_Type := Attribute.Value.Text;
            Dot_Repl : constant Value_Type :=
                         View.Attribute
                           (PRA.Naming.Dot_Replacement).Value.Text;
         begin
            if Value /= No_Value and then ASF.Index (Value, ".") = 0 then
               Log_Error
                 (Message.Error,
                  """" & Value & """ is illegal for "
                  & Image (Attribute_Name.Attr) & ": must have a dot",
                  Attribute);

               return;
            end if;

            --  Case of dot replacement is a single dot, and first character of
            --  suffix is also a dot.

            if Value'Length /= 0
              and then Dot_Repl'Length /= 0
              and then Dot_Repl = "."
              and then Value (Value'First) = '.'
            then
               for Index in Value'First + 1 .. Value'Last loop
                  --  If there are multiple dots in the name

                  if Value (Index) = '.' then
                     --  A letter is illegal following the initial dot

                     if ACH.Is_Letter (Value (Value'First + 1)) then
                        Log_Error
                          (Message.Error,
                           """" & Value & """ is illegal for "
                           & Image (Attribute_Name.Attr)
                           & ": ambiguous prefix when "
                           & "Dot_Replacement is a dot",
                           Attribute);
                     end if;

                     return;
                  end if;
               end loop;
            end if;

            --  detect/report multiple use of same suffix.
            --  Separate_Suffix = Body_Suffix ("Ada") is allowed.
            declare
               Associated_Lang : constant Suffix_Lang_Maps.Cursor :=
                                   Suffix_Lang_Map.Find (Value);
               Index           : constant Attribute_Index.Object :=
                                   Attribute_Index.Create (Ada_Language);
            begin
               if Suffix_Lang_Maps.Has_Element (Associated_Lang) then
                  if Suffix_Lang_Maps.Element (Associated_Lang) = Ada_Language
                    and then Attribute_Name = PRA.Naming.Separate_Suffix
                    and then View.Has_Attribute
                               (Name => PRA.Naming.Body_Suffix, Index => Index)
                    and then View.Attribute
                      (PRA.Naming.Body_Suffix, Index).Value.Text = Value
                  then
                     return;
                  end if;

                  if Language = Suffix_Lang_Maps.Element (Associated_Lang) then
                     Log_Error
                       (Message.Error,
                        Image (Attribute_Name.Attr) & " ("
                        & Image (Language) &
                        ") value already used for this language",
                        Attribute);
                  else
                     Log_Error
                       (Message.Error,
                        Image (Attribute_Name.Attr) & " ("
                        & Image (Language) &
                        ") value is already used for language " &
                        Image (Suffix_Lang_Maps.Element (Associated_Lang)),
                        Attribute);
                  end if;
               else
                  Suffix_Lang_Map.Include (Value, Language);
               end if;
            end;

         end Check_Illegal_Suffix;

         ---------------
         -- Log_Error --
         ---------------

         procedure Log_Error
           (Level     : Message.Level_Value;
            Msg       : String;
            Attribute : Project.Attribute.Object)
         is
         begin
            View.Tree.Log_Messages.Append
              (Message.Create
                 (Level   => Level,
                  Sloc    => Attribute,
                  Message => Msg));
         end Log_Error;

      begin
         if View.Has_Package (PRP.Naming) then
            Check_Casing;
            Check_Dot_Replacement;

            if View.Kind /= K_Aggregate and then View.Has_Languages then
               for L of View.Languages loop
                  declare
                     Language    : constant Language_Id := +Name_Type (L.Text);
                     Index       : constant Attribute_Index.Object :=
                                     Attribute_Index.Create (Language);
                     Spec_Suffix : constant Attribute.Object :=
                                     View.Attribute
                                       (PRA.Naming.Spec_Suffix, Index);
                     Body_Suffix : constant Attribute.Object :=
                                     View.Attribute
                                       (PRA.Naming.Body_Suffix, Index);
                  begin
                     if Spec_Suffix.Is_Defined
                       and then not Spec_Suffix.Is_Default
                     then
                        Check_Illegal_Suffix
                          (PRA.Naming.Spec_Suffix,
                           Language,
                           Spec_Suffix);
                     end if;

                     if Body_Suffix.Is_Defined
                       and then not Body_Suffix.Is_Default
                     then
                        Check_Illegal_Suffix
                          (PRA.Naming.Body_Suffix,
                           Language,
                           Body_Suffix);
                     end if;
                  end;
               end loop;
            end if;

            declare
               Sep_Suffix : constant Attribute.Object :=
                              View.Attribute (PRA.Naming.Separate_Suffix);
            begin
               if Sep_Suffix.Is_Defined and then not Sep_Suffix.Is_Default then
                  Check_Illegal_Suffix
                    (PRA.Naming.Separate_Suffix,
                     Ada_Language,
                     Sep_Suffix);
               end if;
            end;
         end if;
      end Check_View;

   begin
      for C in View.Tree.Iterate loop
         Check_View (Project.Tree.Element (C));
      end loop;
   end Check_Package_Naming;

   ------------------------------
   -- Check_Same_Name_Extended --
   ------------------------------

   procedure Check_Same_Name_Extended (View : Project.View.Object) is
      procedure Check_View (View : Project.View.Object);
      --  Checks in View tree (extended, aggregated, imported) that
      --  any extending list contains unique project name.

      ----------------
      -- Check_View --
      ----------------

      procedure Check_View (View : Project.View.Object) is
         OK    : Boolean;
         CN    : Containers.Name_Type_Set.Cursor;

         Names : Containers.Name_Set;
         --  Set of already found extended projects' names

         procedure Check_Extending (View : Project.View.Object);
         --  If View is extending, checks that extended projects list contains
         --  unique project names.

         ---------------------
         -- Check_Extending --
         ---------------------

         procedure Check_Extending (View : Project.View.Object) is
         begin
            if View.Is_Extending then
               Names.Insert (View.Name, CN, OK);

               if not OK then
                  declare
                     Extending : constant Project.View.Object :=
                                   (if View.Is_Extended
                                    then View.Extending
                                    else View);
                  begin
                     View.Tree.Log_Messages.Append
                       (Message.Create
                          (Level   => Message.Error,
                           Sloc    => SR.Value.Create
                             (Filename => Extending.Path_Name.Value,
                              Line     => 0,
                              Column   => 0,
                              Text     => ""),
                           Message =>
                             "cannot extend a project with the same name"));
                  end;
               end if;

               Check_Extending (View.Extended_Root);
            end if;
         end Check_Extending;

         Def  : constant Const_Ref := Get_RO (View);

      begin
         Check_Extending (View);

         for V of Def.Imports loop
            Check_View (V);
         end loop;

         for V of Def.Aggregated loop
            Check_View (V);
         end loop;

      end Check_View;

   begin
      Check_View (View);
   end Check_Same_Name_Extended;

   -----------------
   -- Clear_Cache --
   -----------------

   procedure Clear_Cache (Def : in out Data)
   is
   begin
      Def.Cache.Clear_Cache;
      Def.Dir_Cache := (others => <>);
   end Clear_Cache;

   -------------------
   -- Disable_Cache --
   -------------------

   procedure Disable_Cache (Def : in out Data)
   is
   begin
      Def.Cache.Disable_Cache;
   end Disable_Cache;

   ------------------
   -- Enable_Cache --
   ------------------

   procedure Enable_Cache (Def : in out Data)
   is
   begin
      Def.Cache.Enable_Cache;
   end Enable_Cache;

   -------------
   -- Foreach --
   -------------

   procedure Foreach
     (Base_Dir          : Path_Name.Object;
      Messages          : in out Log.Object;
      Directory_Pattern : Filename_Optional;
      Source            : Source_Reference.Value.Object;
      File_CB           : access procedure
                            (File      : Path_Name.Object;
                             Timestamp : Ada.Calendar.Time);
      Directory_CB      : access procedure
                            (Directory       : Path_Name.Object;
                             Is_Root_Dir     : Boolean;
                             Do_Dir_Visit    : in out Boolean;
                             Do_Subdir_Visit : in out Boolean) := null)
   is
      use GNATCOLL.Utils;
      use GNATCOLL.OS.Dir;
      use GNATCOLL.OS.Stat;

      type Walk_State is record
         Do_Dir_Visit    : Boolean;
         Do_Subdir_Visit : Boolean;
         Is_Root_Dir     : Boolean;
         Dir             : Path_Name.Object;
         Handle          : Dir_Handle;
      end record;

      type Walk_State_List is array (Positive range <>) of Walk_State;
      type Walk_State_List_Access is access all Walk_State_List;

      procedure Free is new Ada.Unchecked_Deallocation
        (Walk_State_List, Walk_State_List_Access);

      States    : Walk_State_List_Access := new Walk_State_List (1 .. 4);
      New_States : Walk_State_List_Access;
      Current   : Natural := 0;
      Dir       : constant String :=
                    (if Directory_Pattern'Length = 0
                     then "."
                     else
                       (if Directory_Pattern = "**"
                        then "./**"
                        else String (Directory_Pattern)));
      --  Normalize dir part avoiding "" & "**"
      Recursive : constant Boolean :=
                    Dir'Length > 2
                    and then Dir (Dir'Last - 1 .. Dir'Last) = "**"
                    and then Is_Directory_Separator (Dir (Dir'Last - 2));
      Last      : constant Positive :=
                    Dir'Last - (if Recursive then 2 else 0);
      Root_Dir  : constant String :=
                    (if GNAT.OS_Lib.Is_Absolute_Path (Dir)
                     then Dir (Dir'First .. Last)
                     else Base_Dir.Compose
                       (Filename_Optional (Dir (Dir'First .. Last))).Value);
      D_Entry   : Dir_Entry;
      Stat      : File_Attributes;

      procedure Open_Directory
        (Dir         : Path_Name.Object;
         Is_Root_Dir : Boolean);
      --  Open a new directory for walk

      --------------------
      -- Open_Directory --
      --------------------

      procedure Open_Directory
        (Dir         : Path_Name.Object;
         Is_Root_Dir : Boolean)
      is
      begin
         if Current >= 512 then
            Messages.Append
              (Message.Create
                 (Message.Error,
                  "directory depth too big for """ &
                    String (Dir.Name) & """",
                  Source));
            return;

         elsif Current = States'Last then
            New_States := new Walk_State_List (1 .. 2 * States'Length);
            New_States (1 .. States'Length) := States.all;
            Free (States);
            States := New_States;
         end if;

         Current := Current + 1;
         States (Current) :=
           (Handle          => <>,
            Dir             => Dir,
            Do_Dir_Visit    => File_CB /= null,
            Do_Subdir_Visit => Recursive,
            Is_Root_Dir     => Is_Root_Dir);

         if Directory_CB /= null then
            Directory_CB
              (Dir,
               Is_Root_Dir,
               States (Current).Do_Dir_Visit,
               States (Current).Do_Subdir_Visit);
         end if;

         if not States (Current).Do_Dir_Visit
           and then not States (Current).Do_Subdir_Visit
         then
            Current := Current - 1;
            return;
         end if;

         begin
            States (Current).Handle := Open (String (Dir.Value));

         exception
            when GNATCOLL.OS.OS_Error =>
               Current := Current - 1;

               Messages.Append
                 (Message.Create
                    (Message.Error,
                     """" & String (Dir.Name) &
                       """ is not a valid directory",
                     Source));
               return;
         end;
      end Open_Directory;

   begin
      Open_Directory
        (Path_Name.Create_Directory
           (Filename_Type (Root_Dir), Path_Name.No_Resolution),
         Is_Root_Dir => True);

      while Current > 0 loop
         begin
            if States (Current).Do_Dir_Visit
              or else States (Current).Do_Subdir_Visit
            then
               loop
                  D_Entry := Read (States (Current).Handle);

                  exit when End_Of_Iteration (D_Entry);

                  Stat := Attributes (D_Entry);

                  if States (Current).Do_Dir_Visit and then Is_File (Stat) then
                     File_CB
                       (States (Current).Dir.Compose
                          (Filename_Type (Name (D_Entry))),
                        Modification_Time (Stat));

                  elsif States (Current).Do_Subdir_Visit
                    and then Is_Directory (Stat)
                    and then Name (D_Entry) not in "." | ".."
                  then
                     Open_Directory
                       (States (Current).Dir.Compose
                          (Filename_Type (Name (D_Entry)),
                           Directory => True),
                        Is_Root_Dir => False);
                  end if;
               end loop;
            end if;

            Close (States (Current).Handle);
            Current := Current - 1;

         exception
            when others =>
               for C in 1 .. Current loop
                  Close (States (C).Handle);
               end loop;

               Free (States);

               raise;
         end;
      end loop;

      Free (States);
   end Foreach;

   -----------------------
   -- Is_Sources_Loaded --
   -----------------------

   function Is_Sources_Loaded (View : Project.View.Object) return Boolean is
   begin
      return not Get_RO (View).Sources_Map.Is_Empty;
   end Is_Sources_Loaded;

   -----------------------
   -- Source_Map_Insert --
   -----------------------

   procedure Sources_Map_Insert
     (Def : in out Data;
      Src : Project.Source.Object;
      C   : Project.Source.Set.Cursor)
   is
      Position : Simple_Name_Source.Cursor;
      Inserted : Boolean;
   begin
      Def.Sources_Map.Insert
        (Src.Path_Name.Simple_Name, C, Position, Inserted);
   end Sources_Map_Insert;

   --------------------
   -- Update_Sources --
   --------------------

   procedure Update_Sources
     (Def           : in out Data;
      View          : Project.View.Object;
      Stop_On_Error : Boolean;
      Backends      : Source_Info.Backend_Set)
   is
   begin
      Update_Sources_List (Def, View, Stop_On_Error);
      Update_Sources_Parse
        (Def, Backends);
   end Update_Sources;

   -------------------------
   -- Update_Sources_List --
   -------------------------

   procedure Update_Sources_List
     (Def           : in out Data;
      View          : Project.View.Object;
      Stop_On_Error : Boolean) is separate;

   --------------------------
   -- Update_Sources_Parse --
   --------------------------

   procedure Update_Sources_Parse
     (Def : in out Data; Backends : Source_Info.Backend_Set)
   is
      use type GPR2.Source_Info.Backend_Set;

      Repeat_Map  : Simple_Name_Source.Map; -- Second pass for subunits
      Position    : Simple_Name_Source.Cursor;
      Inserted    : Boolean;
      SW          : Project.Source.Object;

   begin
      Source_Info.Parser.Registry.Clear_Cache;
      Def.Units_Map.Clear;

      for C in Def.Sources.Iterate loop
         SW := Project.Source.Set.Element (C);

         --  If the view is extended, we will use the ALI from the extending
         --  project. We still need to call SW.Update to disambiguate
         --  Spec/Spec_Only and Body/Body_Only units.

         SW.Update
           (C,
            (if not Def.Is_Extended
             then Backends
             else Source_Info.No_Backends));

         if not SW.Is_Parsed (No_Index)
           and then not Def.Is_Extended
           and then SW.Language = Ada_Language
           and then Backends /= Source_Info.No_Backends
         then
            --  It can be subunit case in runtime krunched source names, need
            --  to repeat after all .ali files parsed.

            Repeat_Map.Insert
              (SW.Path_Name.Simple_Name, C, Position, Inserted);

            pragma Assert
              (Inserted,
               String (SW.Path_Name.Simple_Name) & " subunit duplicated");
         end if;
      end loop;

      for C of Repeat_Map loop
         SW := Project.Source.Set.Element (C);
         SW.Update (C, Backends);
      end loop;

      --  Check unit-based interface attributes

      if not Def.Interface_Units.Is_Empty then
         for C in Def.Interface_Units.Iterate loop
            declare
               Name : constant Name_Type := Unit_Name_To_Sloc.Key (C);
            begin
               if not Def.Units_Map.Contains ('S' & To_Lower (Name))
                 and then not Def.Units_Map.Contains ('B' & To_Lower (Name))
               then
                  Def.Tree.Append_Message
                    (Message.Create
                       (Message.Error,
                        "source for interface unit '" & String (Name)
                        & "' not found",
                        Unit_Name_To_Sloc.Element (C)));
               end if;
            end;
         end loop;
      end if;
   end Update_Sources_Parse;

end GPR2.Project.Definition;