libgpr2_25.0.0_70fe0fcf/src/private/gpr2-build-view_tables-update_sources_list.adb

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

with Ada.Characters.Handling;
with Ada.Containers.Doubly_Linked_Lists;

with GPR2.Build.Unit_Info.List;
with GPR2.Build.Source_Base.Ada_Parser;
with GPR2.Containers;
with GPR2.Project.Attribute;
with GPR2.Project.Attribute_Index;
with GPR2.Project.Registry.Attribute;
with GPR2.Project.Registry.Pack;
with GPR2.Project.View;
with GPR2.Source_Reference.Value;
with GPR2.View_Internal;

separate (GPR2.Build.View_Tables)
package body Update_Sources_List is

   use type Project.Attribute.Object;
   package PAI renames GPR2.Project.Attribute_Index;

   use GPR2.Path_Name;

   package PRA renames GPR2.Project.Registry.Attribute;
   package PRP renames GPR2.Project.Registry.Pack;
   package SR  renames GPR2.Source_Reference;

   package Attribute_List is new
     Ada.Containers.Doubly_Linked_Lists (Project.Attribute.Object);
   --  Element type for Source_Path_To_Attribute_List below

   package Source_Path_To_Attribute_List is new
     Ada.Containers.Indefinite_Hashed_Maps
       (Key_Type        => Filename_Type,
        Element_Type    => Attribute_List.List,
        Hash            => GPR2.Hash,
        Equivalent_Keys => GPR2."=",
        "="             => Attribute_List."=");
   --  Used for the Ada_Naming_Exceptions container which maps a filename to
   --  the list of naming attributes (Body/Spec) that reference it.

   type Naming_Schema
     (Spec_Suffix_Length,
      Body_Suffix_Length,
      Separate_Suffix_Length : Natural)
   is record
      Has_Spec_Suffix     : Boolean;
      Has_Body_Suffix     : Boolean;
      Has_Separate_Suffix : Boolean;
      Spec_Suffix         : String (1 .. Spec_Suffix_Length);
      Body_Suffix         : String (1 .. Body_Suffix_Length);
      Sep_Suffix          : String (1 .. Separate_Suffix_Length);
   end record;

   package Naming_Schema_Maps is new Ada.Containers.Indefinite_Hashed_Maps
     (Language_Id, Naming_Schema, GPR2.Hash, GPR2."=");

   package Lang_Boolean_Map is new Ada.Containers.Hashed_Maps
     (Language_Id, Boolean, Hash, "=");

   procedure Fill_Ada_Naming_Exceptions
     (View         : GPR2.Project.View.Object;
      Attr         : Attribute_Id;
      Src_Map      : in out Source_Path_To_Attribute_List.Map)
     with Pre => Attr in  PRA.Naming.Spec.Attr | PRA.Naming.Body_N.Attr;
   --  Populate the src->unit and unit->src maps for Ada sources

   procedure Fill_Naming_Schema
     (View : Project.View.Object;
      Map  : in out Naming_Schema_Maps.Map);
   --  Populate Map with the naming schema information from view, for every
   --  language in use for the view.

   function Compute_Unit_From_Filename
     (File     : Filename_Type;
      Kind     : Valid_Unit_Kind;
      NS       : Naming_Schema;
      Dot_Repl : String;
      Messages : in out GPR2.Log.Object;
      Last_Dot : out Natural;
      Success  : out Boolean) return Name_Type;
   --  For an Ada source and given its kind, try to compute a valid unit
   --  name. Success takes True if such a valid name is found.
   --  Set Last_Dot to last dot index in result to split separate unit
   --  name.

   procedure Krunch
     (Buffer        : in out String;
      Len           : in out Natural;
      Maxlen        : Natural;
      No_Predef     : Boolean);
   --  From gnat tools: krunch a unit name to achieve a short-variant for the
   --  source filename

   function Krunch (Unit_Name : Name_Type) return Filename_Type;
   --  convenient wrapper around the above procedure

   function Compute_Unit_From_Filename
     (File     : Filename_Type;
      Kind     : Valid_Unit_Kind;
      NS       : Naming_Schema;
      Dot_Repl : String;
      Messages : in out GPR2.Log.Object;
      Last_Dot : out Natural;
      Success  : out Boolean) return Name_Type
   is
      use Ada.Strings;
      use Ada.Strings.Maps;

      Result     : Unbounded_String := +GPR2.Path_Name.Simple_Name (File);
      Default_NS : constant  Boolean :=
                     NS.Spec_Suffix = ".ads" and then NS.Body_Suffix = ".adb"
                      and then NS.Sep_Suffix = ".adb" and then Dot_Repl = "-";
      --  True if the current naming scheme is GNAT's default naming scheme.
      --  This is to take into account shortened names like "Ada." (a-),
      --  "System." (s-) and so on.
   begin
      --  Check binder-generated source, and ignore it

      if Length (Result) > 3
        and then Slice (Result, 1, 3) = "b__"
      then
         goto Invalid;
      end if;

      --  First remove the suffix for the given language

      declare
         Suffix : constant Value_Type :=
                    (case Kind is
                        when S_Spec     => NS.Spec_Suffix,
                        when S_Body     => NS.Body_Suffix,
                        when S_Separate => NS.Sep_Suffix);
      begin
         if Length (Result) > Suffix'Length then
            Delete
              (Result,
               From    => Length (Result) - Suffix'Length + 1,
               Through => Length (Result));
         end if;
      end;

      --  If Dot_Replacement is not a single dot, then there should not
      --  be any dot in the name.

      if Dot_Repl /= "." then
         if Index (Result, ".") /= 0 then
            Messages.Append
              (Message.Create
                 (Message.Information, "invalid file name, contains dot",
                  SR.Create (Full_Name (File), 1, 1)));
            Last_Dot := 0;
            goto Invalid;

         else
            declare
               I : Natural := 1;
            begin
               Last_Dot := 0;

               loop
                  I := Index (Result, Dot_Repl, From => I);
                  exit when I = 0;

                  Replace_Slice
                    (Result, I, I + Dot_Repl'Length - 1, ".");

                  Last_Dot := I;
               end loop;
            end;
         end if;

      else
         Last_Dot := Index (Result, Dot_Repl, Going => Backward);
      end if;

      --  In the standard GNAT naming scheme, check for special cases:
      --  children or separates of A, G, I or S, and run time sources.

      if Default_NS and then Length (Result) >= 3 then
         declare
            S1 : constant Character := Element (Result, 1);
            S2 : constant Character := Element (Result, 2);

         begin
            if S1 in 'a' | 'g' | 'i' | 's' then
               --  Children or separates of packages A, G, I or S. These
               --  names are x~... (where x is a, g, i, or s).

               if S2 = '~' then
                  Replace_Element (Result, 2, '.');
               end if;

               --  We do nothing with S2 = '.' case here because it can
               --  be regular package with one letter named parent. We
               --  will detect runtime source later at unit name
               --  clarification stage in Ada or ALI parser.
            end if;
         end;
      end if;

      Success := True;

      return Name_Type (To_String (Result));

      <<Invalid>>

      Success := False;

      return "0"; -- Some dummy unit name
   end Compute_Unit_From_Filename;

   --------------------------------
   -- Fill_Ada_Naming_Exceptions --
   --------------------------------

   procedure Fill_Ada_Naming_Exceptions
     (View         : GPR2.Project.View.Object;
      Attr         : Attribute_Id;
      Src_Map      : in out Source_Path_To_Attribute_List.Map)
   is
   begin
      for A of View.Attributes
        (Name          => (PRP.Naming, Attr),
         With_Defaults => False,
         With_Config   => False)
      loop
         declare
            Source          : constant Filename_Type :=
                                Filename_Type (A.Value.Text);
            Insert_Position : Source_Path_To_Attribute_List.Cursor;
            Is_Inserted     : Boolean;
         begin
            Src_Map.Insert
              (Key      => Source,
               New_Item => Attribute_List.Empty_List,
               Position => Insert_Position,
               Inserted => Is_Inserted);
            Src_Map (Insert_Position).Append (A);
         end;
      end loop;
   end Fill_Ada_Naming_Exceptions;

   ------------------------
   -- Fill_Naming_Schema --
   ------------------------

   procedure Fill_Naming_Schema
     (View : Project.View.Object;
      Map  : in out Naming_Schema_Maps.Map)
   is
   begin
      for L of View.Languages loop
         declare
            Lang            : constant Language_Id := +Name_Type (L.Text);
            Has_Spec_Suffix : constant Boolean :=
                                View.Has_Spec_Suffix (Lang);
            Spec_Suffix     : constant String :=
                                (if Has_Spec_Suffix
                                 then View.Spec_Suffix (Lang).Value.Text
                                 else "");
            Has_Body_Suffix : constant Boolean :=
                                View.Has_Body_Suffix (Lang);
            Body_Suffix     : constant String :=
                                (if Has_Body_Suffix
                                 then View.Body_Suffix (Lang).Value.Text
                                 else "");
            Has_Sep_Suffix  : constant Boolean :=
                                Lang = Ada_Language
                                    and then View.Has_Separate_Suffix;
            Sep_Suffix      : constant String :=
                                (if Has_Sep_Suffix
                                 then View.Separate_Suffix.Value.Text
                                 else "");
         begin
            Map.Insert
              (Lang,
               (Spec_Suffix_Length     => Spec_Suffix'Length,
                Body_Suffix_Length     => Body_Suffix'Length,
                Separate_Suffix_Length => Sep_Suffix'Length,
                Has_Spec_Suffix        => Has_Spec_Suffix,
                Has_Body_Suffix        => Has_Body_Suffix,
                Has_Separate_Suffix    => Has_Sep_Suffix,
                Spec_Suffix            => Spec_Suffix,
                Body_Suffix            => Body_Suffix,
                Sep_Suffix             => Sep_Suffix));
         end;
      end loop;
   end Fill_Naming_Schema;

   ------------
   -- Krunch --
   ------------

   procedure Krunch
     (Buffer        : in out String;
      Len           : in out Natural;
      Maxlen        : Natural;
      No_Predef     : Boolean)
   is
      pragma Assert (Buffer'First = 1);
      --  This is a documented requirement; the assert turns off index warnings

      B1       : Character renames Buffer (1);
      Curlen   : Natural;
      Krlen    : Natural;
      Num_Seps : Natural;
      Startloc : Natural;
      J        : Natural;

   begin
      --  Deal with special predefined children cases. Startloc is the first
      --  location for the krunch, set to 1, except for the predefined children
      --  case, where it is set to 3, to start after the standard prefix.

      if No_Predef then
         Startloc := 1;
         Curlen := Len;
         Krlen := Maxlen;

      elsif Len >= 18
        and then Buffer (1 .. 17) = "ada-wide_text_io-"
      then
         Startloc := 3;
         Buffer (2 .. 5) := "-wt-";
         Buffer (6 .. Len - 12) := Buffer (18 .. Len);
         Curlen := Len - 12;
         Krlen  := 8;

      elsif Len >= 23
        and then Buffer (1 .. 22) = "ada-wide_wide_text_io-"
      then
         Startloc := 3;
         Buffer (2 .. 5) := "-zt-";
         Buffer (6 .. Len - 17) := Buffer (23 .. Len);
         Curlen := Len - 17;
         Krlen := 8;

      elsif Len >= 27
        and then Buffer (1 .. 27) = "ada-long_long_long_integer_"
      then
         Startloc := 3;
         Buffer (2 .. Len - 2) := Buffer (4 .. Len);
         Buffer (18 .. Len - 10) := Buffer (26 .. Len - 2);
         Curlen := Len - 10;
         Krlen := 8;

      elsif Len >= 4 and then Buffer (1 .. 4) = "ada-" then
         Startloc := 3;
         Buffer (2 .. Len - 2) := Buffer (4 .. Len);
         Curlen := Len - 2;
         Krlen  := 8;

      elsif Len >= 5 and then Buffer (1 .. 5) = "gnat-" then
         Startloc := 3;
         Buffer (2 .. Len - 3) := Buffer (5 .. Len);
         Curlen := Len - 3;
         Krlen  := 8;

      elsif Len >= 7 and then Buffer (1 .. 7) = "system-" then
         Startloc := 3;
         Buffer (2 .. Len - 5) := Buffer (7 .. Len);
         Curlen := Len - 5;
         if (Curlen >= 3 and then Buffer (Curlen - 2 .. Curlen) = "128")
           or else (Len >= 9 and then
                      (Buffer (3 .. 9) = "exn_lll"
                       or else Buffer (3 .. 9) = "exp_lll"
                       or else Buffer (3 .. 9) = "img_lll"
                       or else Buffer (3 .. 9) = "val_lll"
                       or else Buffer (3 .. 9) = "wid_lll"))
           or else (Curlen = 10 and then Buffer (3 .. 6) = "pack")
         then
            if Len >= 15 and then Buffer (3 .. 15) = "compare_array" then
               Buffer (3 .. 4) := "ca";
               Buffer (5 .. Curlen - 11) := Buffer (16 .. Curlen);
               Curlen := Curlen - 11;
            end if;
            Krlen := 9;
         else
            Krlen := 8;
         end if;

      elsif Len >= 11 and then Buffer (1 .. 11) = "interfaces-" then
         Startloc := 3;
         Buffer (2 .. Len - 9) := Buffer (11 .. Len);
         Curlen := Len - 9;

         --  Only fully krunch historical units. For new units, simply use
         --  the 'i-' prefix instead of 'interfaces-'. Packages Interfaces.C
         --  and Interfaces.Cobol are already in the right form. Package
         --  Interfaces.Definitions is krunched for backward compatibility.

         if        (Curlen >  3 and then Buffer (3 ..  4) = "c-")
           or else (Curlen >  3 and then Buffer (3 ..  4) = "c_")
           or else (Curlen = 13 and then Buffer (3 .. 13) = "definitions")
           or else (Curlen =  9 and then Buffer (3 ..  9) = "fortran")
           or else (Curlen = 16 and then Buffer (3 .. 16) = "packed_decimal")
           or else (Curlen >  8 and then Buffer (3 ..  9) = "vxworks")
           or else (Curlen >  5 and then Buffer (3 ..  6) = "java")
         then
            Krlen := 8;
         else
            Krlen := Maxlen;
         end if;

         --  For the renamings in the obsolescent section, we also force
         --  krunching to 8 characters, but no other special processing is
         --  required here. Note that text_io and calendar are already short
         --  enough anyway.

      elsif     (Len =  9 and then Buffer (1 ..  9) = "direct_io")
        or else (Len = 10 and then Buffer (1 .. 10) = "interfaces")
        or else (Len = 13 and then Buffer (1 .. 13) = "io_exceptions")
        or else (Len = 12 and then Buffer (1 .. 12) = "machine_code")
        or else (Len = 13 and then Buffer (1 .. 13) = "sequential_io")
        or else (Len = 20 and then Buffer (1 .. 20) = "unchecked_conversion")
        or else (Len = 22 and then Buffer (1 .. 22) = "unchecked_deallocation")
      then
         Startloc := 1;
         Krlen    := 8;
         Curlen   := Len;

         --  Special case of a child unit whose parent unit is a single letter
         --  that is A, G, I, or S. In order to prevent confusion with krunched
         --  names of predefined units use a tilde rather than a minus as the
         --  second character of the file name.

      elsif Len > 1
        and then Buffer (2) = '-'
        and then (B1 = 'a' or else B1 = 'g' or else B1 = 'i' or else B1 = 's')
        and then Len <= Maxlen
      then
         Buffer (2) := '~';
         return;

         --  Normal case, not a predefined file

      else
         Startloc := 1;
         Curlen   := Len;
         Krlen    := Maxlen;
      end if;

      --  Immediate return if file name is short enough now

      if Curlen <= Krlen then
         Len := Curlen;
         return;
      end if;

      --  If string contains Wide_Wide, replace by a single z

      J := Startloc;
      while J <= Curlen - 8 loop
         if Buffer (J .. J + 8) = "wide_wide"
           and then (J = Startloc
                     or else Buffer (J - 1) = '-'
                     or else Buffer (J - 1) = '_')
           and then (J + 8 = Curlen
                     or else Buffer (J + 9) = '-'
                     or else Buffer (J + 9) = '_')
         then
            Buffer (J) := 'z';
            Buffer (J + 1 .. Curlen - 8) := Buffer (J + 9 .. Curlen);
            Curlen := Curlen - 8;
         end if;

         J := J + 1;
      end loop;

      --  For now, refuse to krunch a name that contains an ESC character (wide
      --  character sequence) since it's too much trouble to do this right ???

      for J in 1 .. Curlen loop
         if Buffer (J) = ASCII.ESC then
            return;
         end if;
      end loop;

      --  Count number of separators (minus signs and underscores) and for now
      --  replace them by spaces. We keep them around till the end to control
      --  the krunching process, and then we eliminate them as the last step

      Num_Seps := 0;
      for J in Startloc .. Curlen loop
         if Buffer (J) = '-' or else Buffer (J) = '_' then
            Buffer (J) := ' ';
            Num_Seps := Num_Seps + 1;
         end if;
      end loop;

      --  Now we do the one character at a time krunch till we are short enough

      while Curlen - Num_Seps > Krlen loop
         declare
            Long_Length : Natural := 0;
            Long_Last   : Natural := 0;
            Piece_Start : Natural;
            Ptr         : Natural;

         begin
            Ptr := Startloc;

            --  Loop through pieces to find longest piece

            while Ptr <= Curlen loop
               Piece_Start := Ptr;

               --  Loop through characters in one piece of name

               while Ptr <= Curlen and then Buffer (Ptr) /= ' ' loop
                  Ptr := Ptr + 1;
               end loop;

               if Ptr - Piece_Start > Long_Length then
                  Long_Length := Ptr - Piece_Start;
                  Long_Last := Ptr - 1;
               end if;

               Ptr := Ptr + 1;
            end loop;

            --  Remove last character of longest piece

            if Long_Last < Curlen then
               Buffer (Long_Last .. Curlen - 1) :=
                 Buffer (Long_Last + 1 .. Curlen);
            end if;

            Curlen := Curlen - 1;
         end;
      end loop;

      --  Final step, remove the spaces

      Len := 0;

      for J in 1 .. Curlen loop
         if Buffer (J) /= ' ' then
            Len := Len + 1;
            Buffer (Len) := Buffer (J);
         end if;
      end loop;

      return;
   end Krunch;

   function Krunch (Unit_Name : Name_Type) return Filename_Type is
      Buffer : String := Ada.Characters.Handling.To_Lower (String (Unit_Name));
      Len    : Natural := Buffer'Last;
   begin
      for J in Buffer'Range loop
         if Buffer (J) = '.' then
            Buffer (J) := '-';
         end if;
      end loop;

      Krunch (Buffer, Len, 8, False);

      return Filename_Type (Buffer (1 .. Len));
   end Krunch;

   -------------
   -- Process --
   -------------

   procedure Process
     (Data          : View_Data_Ref;
      Stop_On_Error : Boolean;
      Messages      : in out GPR2.Log.Object)
   is
      function Is_Compilable (Language : Language_Id) return Boolean;
      --  Check whether the language is compilable on the current View. This
      --  includes information provided by the Tree (Driver attribute). Note
      --  that this routine caches the result into a map.

      procedure Handle_File
        (Dir_Index : Natural;
         File      : GPR2.Path_Name.Full_Name;
         Timestamp : Ada.Calendar.Time);
      --  Callback to Source_Directories_Walk: update the list of files found
      --  in the source directories.

      function Process_File (File : File_Info) return Boolean;

      Tree          : constant not null access Tree_Internal.Object :=
                        View_Internal.Get_RO (Data.View).Tree;

      Previous_Files     : File_Sets.Set := Data.Src_Files;
      --  List of files that were present in the source dirs during last call
      --  to Process. Used for delta updates

      Changed_Sources    : Basename_Sets.Set;

      Current_Src_Dir_Idx   : Natural := 0;
      --  Identifies the Source_Dirs value being processed

      Dot_Repl : constant String :=
                   Data.View.Attribute (PRA.Naming.Dot_Replacement).Value.Text;
      --  Get Dot_Replacement value

      Source_Name_Set       : GPR2.Containers.Filename_Set;
      --  Collection of source simple names for a given Source_Dirs value

      Naming_Schema_Map     : Naming_Schema_Maps.Map;

      Ada_Naming_Exceptions : Source_Path_To_Attribute_List.Map;
      Attr                  : Project.Attribute.Object;

      Compilable_Language   : Lang_Boolean_Map.Map;
      --  List of compilable languages for the view

      Parser_State          : GPR2.Build.Source_Base.Ada_Parser.Parser_State;

      -----------------
      -- Handle_File --
      -----------------

      procedure Handle_File
        (Dir_Index : Natural;
         File      : GPR2.Path_Name.Full_Name;
         Timestamp : Ada.Calendar.Time)
      is
      begin
         Data.Src_Files.Include ((File'Length, Timestamp, Dir_Index, File));
      end Handle_File;

      -------------------
      -- Is_Compilable --
      -------------------

      function Is_Compilable (Language : Language_Id) return Boolean
      is
         C    : constant Lang_Boolean_Map.Cursor :=
                  Compilable_Language.Find (Language);
         Attr : GPR2.Project.Attribute.Object;
         Res  : Boolean;
      begin
         if not Lang_Boolean_Map.Has_Element (C) then
            Attr := Data.View.Attribute
              (PRA.Compiler.Driver, Project.Attribute_Index.Create (Language));
            Res := Attr.Is_Defined
              and then Length (Attr.Value.Unchecked_Text) > 0;

            Compilable_Language.Insert (Language, Res);

            return Res;

         else
            return Lang_Boolean_Map.Element (C);
         end if;
      end Is_Compilable;

      ------------------
      -- Process_File --
      ------------------

      function Process_File (File : File_Info) return Boolean is

         --  The implementation works as follows:
         --    For every language L in the project:
         --      1- Check if F matches with a naming exception (see
         --         Check_Naming_Exceptions):
         --           - if L is Ada, look F up the Ada_Naming_Exceptions map
         --           - else, check the attributes Implementation_Exceptions
         --             and Specification_Exceptions for the language L.
         --             This was missing in the previous implementation.
         --           - This also computes Kind for non-Ada sources.
         --             For Ada sources we will compute a Kind for every
         --             compilation unit later on.
         --         If a match is found and L is Ada, then compute the
         --         compilation units.
         --      2- If no naming exceptions matched, check the naming scheme
         --         for L (see Check_Naming_Scheme):
         --           - Separate_Suffix is only checked for Ada.
         --           - This time, Kind is computed no matter the language, as
         --             for Ada we will assume the source is single-unit.
         --         If a match is found and L is Ada then compute the single
         --         compilation unit for the source. The unit name is derived
         --         from the file name (see Compute_Unit_From_Filename):
         --           - Validity checks on the unit name are only done here.
         --             Should this be reverted to the previous behavior, i.e.
         --             some checks apply to both the naming exception and
         --             naming scheme cases???
         --      3- If either one or the other method resulted in a match,
         --         - update the source/unit interface containers as done in
         --           the previous implementation (except that the unit and
         --           source interface cases are now handled separately).
         --         - Create the GPR2.Source object. We now have different
         --           constructors for Ada and for other languages. This change
         --           is just to make things more explicit. In addition to the
         --           Units argument, the Ada source constructor
         --           takes a new argument Is_RTS_Source, used to handle this
         --           special case when parsing the source.
         --         - Create the GPR2.Project.Source. Nothing special here.
         --           A new check is added to report duplicate project sources.
         --           Add it to the project definition.
         --         - For Ada, create/add the source object to the project
         --           definition: no change from the initial code, but it is
         --           now inside a loop over the compilation units.
         --         - Exit.

         Basename         : constant Filename_Type :=
                                GPR2.Path_Name.Simple_Name (File.Path);

         type Source_Detection is
           (Naming_Exception,
            Naming_Convention,
            No_Match);
         Match            : Source_Detection := No_Match;
         Units            : Unit_Info.List.Object;  --  For Ada
         Kind             : Valid_Unit_Kind;
         Index            : Unit_Index;
         Source           : Build.Source_Base.Object;
         Attr             : Project.Attribute.Object;
         Ada_Exc_CS       : Source_Path_To_Attribute_List.Cursor;
         Parsed           : Boolean;
         Exc_Attr         : Source_Reference.Object;

      begin
         --  Stop here if it's one of the excluded sources, or it's not in the
         --  included sources if those are given explicitely.

         if Data.Excluded_Sources.Contains (Basename) then
            Data.Actually_Excluded.Include (Basename);

            return False;

         elsif not Data.Listed_Sources.Is_Empty
           and then not Data.Listed_Sources.Contains (Basename)
         then
            return False;
         end if;

         if File.Dir_Idx /= Current_Src_Dir_Idx then
            Current_Src_Dir_Idx := File.Dir_Idx;
            Source_Name_Set.Clear;
         end if;

         for Language of Data.View.Language_Ids loop
            --  First, try naming exceptions

            Match := No_Match;
            Kind  := S_Spec;  --  Dummy value

            if Language = Ada_Language
              and then not Ada_Naming_Exceptions.Is_Empty
            then
               Ada_Exc_CS := Ada_Naming_Exceptions.Find (Basename);

               if Source_Path_To_Attribute_List.Has_Element (Ada_Exc_CS) then
                  for Exc of Ada_Naming_Exceptions (Ada_Exc_CS) loop
                     --  Found at least one: so we have naming exceptions for
                     --  this source

                     Match := Naming_Exception;
                     Exc_Attr := Source_Reference.Object (Exc);

                     if Exc.Value.Has_At_Pos then
                        Index := Exc.Value.At_Pos;
                        pragma Assert (Index /= No_Index);
                     else
                        Index := No_Index;
                     end if;

                     Kind := (if Exc.Name.Id = PRA.Naming.Spec
                              then S_Spec
                              else S_Body);

                     Units.Insert
                       (Unit_Info.Create
                          (Unit_Name      => Name_Type (Exc.Index.Text),
                           Index          => Index,
                           Kind           => Kind));
                  end loop;
               end if;

            elsif Language /= Ada_Language then
               --  Non-Ada case: we suppose that the language doesn't support
               --  the notion of compilation unit.

               if Data.View.Check_Attribute
                    (PRA.Naming.Specification_Exceptions,
                     Project.Attribute_Index.Create (Language),
                     Result => Attr)
                 and then Attr.Has_Value (Value_Type (Basename))
                 --  ??? Doesn't take care of FS casing
               then
                  Match := Naming_Exception;
                  Kind  := S_Spec;

               elsif Data.View.Check_Attribute
                       (PRA.Naming.Implementation_Exceptions,
                        Project.Attribute_Index.Create (Language),
                        Result => Attr)
                 and then Attr.Has_Value (Value_Type (Basename))
               then
                  Match := Naming_Exception;
                  Kind  := S_Body;
               end if;
            end if;

            if Match = No_Match then
               --  If no naming exception matched, try with naming schema

               declare
                  use GNATCOLL.Utils;

                  NS               : Naming_Schema renames
                                       Naming_Schema_Map.Element (Language);
                  Matches_Spec     : Boolean;
                  Matches_Body     : Boolean;
                  Matches_Separate : Boolean;

               begin
                  Matches_Spec := NS.Has_Spec_Suffix
                    and then Ends_With (String (Basename), NS.Spec_Suffix);

                  Matches_Body := NS.Has_Body_Suffix
                    and then Ends_With (String (Basename), NS.Body_Suffix);

                  Matches_Separate := NS.Has_Separate_Suffix
                    and then Ends_With (String (Basename), NS.Sep_Suffix);

                  --  See GA05-012: if there's ambiguity with suffixes (e.g.
                  --  one of the suffixes if a suffix of another) we use
                  --  with the most explicit one (e.g. the longest one)
                  --  that matches.

                  if Matches_Spec and then Matches_Body then
                     if NS.Spec_Suffix'Length >= NS.Body_Suffix'Length then
                        Matches_Body := False;
                     else
                        Matches_Spec := False;
                     end if;
                  end if;

                  if Matches_Spec and then Matches_Separate then
                     if NS.Spec_Suffix'Length >= NS.Sep_Suffix'Length then
                        Matches_Separate := False;
                     else
                        Matches_Spec := False;
                     end if;
                  end if;

                  if Matches_Body and then Matches_Separate then
                     if NS.Body_Suffix'Length >= NS.Sep_Suffix'Length then
                        Matches_Separate := False;
                     else
                        Matches_Body := False;
                     end if;
                  end if;

                  Match := (if Matches_Spec
                              or else Matches_Body
                              or else Matches_Separate
                            then Naming_Convention
                            else No_Match);

                  if Matches_Spec then
                     Kind  := S_Spec;

                  elsif Matches_Body then
                     Kind  := S_Body;

                  elsif Matches_Separate then
                     Kind  := S_Separate;
                  end if;
               end;
            end if;

            --  If we have a match from either naming exception or scheme
            --  we create the Source object.

            if Match /= No_Match then
               Source := Build.Source_Base.Object
                 (Build.Source_Base.Create
                    (Path_Name.Create_File (File.Path),
                     Language         => Language,
                     Kind             => Kind,
                     Timestamp        => File.Stamp,
                     Tree_Db          => Data.Tree_Db,
                     Naming_Exception => Match = Naming_Exception,
                     Source_Dir_Idx   => File.Dir_Idx,
                     Is_Compilable    => Is_Compilable (Language)));

               --  If we know the units in the source (from naming exception),
               --  then add them now.

               for U of Units loop
                  Source.Update_Unit (U);
               end loop;
            end if;

            --  Check Unit names and kind for Ada:

            if Match = Naming_Convention and then Language = Ada_Language then
               declare
                  Last_Dot  : Natural;
                  Success   : Boolean;
                  Unit_Name : constant Name_Type :=
                                Compute_Unit_From_Filename
                                  (File     => File.Path,
                                   Kind     => Kind,
                                   NS       =>
                                     Naming_Schema_Map (Ada_Language),
                                   Dot_Repl => Dot_Repl,
                                   Messages => Messages,
                                   Last_Dot => Last_Dot,
                                   Success  => Success);

               begin
                  if not Success then
                     return False;
                  end if;

                  if not Compilation_Unit.Check_Name_Validity
                    (Unit_Name,
                     Source_Reference.Create (File.Path, 0, 0),
                     False,
                     Messages)
                  then
                     return False;
                  end if;

                  --  There can be ambiguities in Ada with the default naming
                  --  convention or with naming exception with regards to
                  --  separate and child bodies. In order to disambiguate that
                  --  we need to parse the source.

                  --  Parse the source to get unit and update its kind if
                  --  needed.

                  Build.Source_Base.Ada_Parser.Compute
                    (File_Reader      => Tree.File_Reader,
                     State            => Parser_State,
                     Data             => Source,
                     Get_Withed_Units =>
                       Data.Tree_Db.Source_Option >= Sources_Units,
                     Success          => Parsed);

                  --  Check if we have a conflicting naming exception with the
                  --  same unit but a different source

                  if Parsed
                    and then Source.Kind /= S_No_Body
                  then
                     if not Ada_Naming_Exceptions.Is_Empty then
                        declare
                           Attr : GPR2.Project.Attribute.Object;
                        begin
                           if Source.Kind = S_Spec then
                              Attr := Data.View.Attribute
                                (PRA.Naming.Spec,
                                 PAI.Create
                                   (Value_Type (Source.Unit.Full_Name)));
                           else
                              Attr := Data.View.Attribute
                                (PRA.Naming.Body_N,
                                 PAI.Create
                                   (Value_Type (Source.Unit.Full_Name)));
                           end if;

                           if Attr.Is_Defined
                             and then Attr.Value.Text /=
                               String (Source.Path_Name.Simple_Name)
                           then
                              --  We have a naming exception on the unit name
                              --  for a different source, so ignore the other
                              --  sources with the same unit.
                              return False;
                           end if;
                        end;
                     end if;

                     if Unit_Name /= Source.Unit.Full_Name
                       and then Path_Name.Base_Name (File.Path) /=
                         Krunch (Source.Unit.Full_Name)
                     then
                        if Data.View.Is_Runtime then
                           --  Ignore sources from the runtime that don't
                           --  follow the naming convention: they're not
                           --  part of the runtime library.
                           return False;

                        else
                           Messages.Append
                             (Message.Create
                                (Message.Warning,
                                 "unit name """ &
                                   String (Source.Unit.Name) &
                                   """ does not match source name",
                                 SR.Create (File.Path, 0, 0)));
                        end if;
                     end if;

                  elsif not Parsed and then Kind = S_Separate then
                     --  Separates must have a doted unit name

                     if Last_Dot > 0 then
                        Source.Update_Unit
                          (Unit_Info.Create
                             (Unit_Name     => Unit_Name
                                  (Unit_Name'First .. Last_Dot - 1),
                              Index         => No_Index,
                              Kind          => Kind,
                              Separate_Name => Unit_Name
                                (Last_Dot + 1 .. Unit_Name'Last),
                              Parsed        => False));
                     else
                        Messages.Append
                          (Message.Create
                             (Message.Warning,
                              "invalid file name: no '.' in deduced " &
                                "separate unit name """ &
                                String (Unit_Name) & '"',
                              SR.Create (File.Path, 0, 0)));

                        return False;
                     end if;

                  elsif not Parsed then
                     Source.Update_Unit
                       (Unit_Info.Create
                          (Unit_Name     => Unit_Name,
                           Index         => No_Index,
                           Kind          => Kind,
                           Separate_Name => "",
                           Parsed        => False));
                  end if;
               end;

            elsif Match = Naming_Exception
              and then Language = Ada_Language
              and then not Units.Is_Indexed_List
            then
               Build.Source_Base.Ada_Parser.Compute
                 (File_Reader      => Tree.File_Reader,
                  State            => Parser_State,
                  Data             => Source,
                  Get_Withed_Units =>
                    Data.Tree_Db.Source_Option >= Sources_Units,
                  Success          => Parsed);

               --  Check parsed unit name is the same as the one declared
               --  in the gpr project.

               if Parsed
                 and then Source.Unit.Kind /= S_No_Body
                 and then Source.Unit.Full_Name /=
                   Units (No_Index).Full_Name
               then
                  Messages.Append
                    (Message.Create
                       (Message.Warning,
                        "actual unit name """ &
                          String
                          (Source.Unit.Full_Name) &
                          """ differs from the one declared in the " &
                          "project : """ &
                          String (Units (No_Index).Full_Name) & '"',
                        Exc_Attr));
               end if;
            end if;

            if Match /= No_Match then
               Data.Src_Infos.Insert (File.Path, Source);

               return True;
            end if;

            exit when Stop_On_Error and then Tree.Log_Messages.Has_Error;
         end loop;

         return False;
      end Process_File;

   begin
      --  Skip projects that don't have source directories

      if Data.View.Kind not in With_Source_Dirs_Kind then
         return;
      end if;

      --  Prepare tables used to detect actual sources and their language

      Fill_Naming_Schema (Data.View, Naming_Schema_Map);

      if Data.View.Language_Ids.Contains (Ada_Language) then
         Fill_Ada_Naming_Exceptions
           (Data.View, PRA.Naming.Spec.Attr, Ada_Naming_Exceptions);
         Fill_Ada_Naming_Exceptions
           (Data.View, PRA.Naming.Body_N.Attr, Ada_Naming_Exceptions);
      end if;

      --  Lookup for all files in the source directories

      Data.Src_Files.Clear;

      Data.View.Source_Directories_Walk
        (Source_CB => Handle_File'Access,
         Dir_CB    => null,
         Messages  => Messages);

      Changed_Sources.Clear;

      --  Check deleted files

      for F of Previous_Files loop
         if not Data.Src_Files.Contains (F) then
            --  File F has disapeared, check if it was a source file

            declare
               C : Src_Info_Maps.Cursor;
            begin
               C := Data.Src_Infos.Find (F.Path);

               if Src_Info_Maps.Has_Element (C) then
                  --  File was a source and has disapeared: notify the build
                  --  db object to cleanup tables.
                  Remove_Source
                    (Data, Data.View, F.Path,
                     Project.View.Undefined,
                     Messages => Messages);

                  Changed_Sources.Include
                    (Path_Name.Simple_Name (F.Path));
               end if;
            end;
         end if;
      end loop;

      --  Check new or updated sources

      Parser_State := GPR2.Build.Source_Base.Ada_Parser.Create_New_State;

      for F of Data.Src_Files loop
         declare
            use type Ada.Calendar.Time;
            C     : File_Sets.Cursor;
            C2    : Src_Info_Maps.Cursor;

         begin
            C := Previous_Files.Find (F);

            if not File_Sets.Has_Element (C) then
               --  New potential source: process it

               if Process_File (F) then
                  --  First add source to Data view.
                  Add_Source
                    (Data, Data.View, F.Path,
                     Extended_View => Project.View.Undefined,
                     Messages      => Messages);
                  Changed_Sources.Include
                    (Path_Name.Simple_Name (F.Path));
               end if;

            else
               C2 := Data.Src_Infos.Find (F.Path);

               if Src_Info_Maps.Has_Element (C2) then
                  declare
                     Src_Ref : constant Src_Info_Maps.Reference_Type :=
                                 Data.Src_Infos.Reference (C2);
                     Success : Boolean;
                  begin
                     if Src_Ref.Modification_Time /= F.Stamp then
                        Src_Ref.Update_Modification_Time (F.Stamp);

                        if not Src_Ref.Has_Naming_Exception then
                           Source_Base.Ada_Parser.Compute
                             (File_Reader      => Tree.File_Reader,
                              State            => Parser_State,
                              Data             => Src_Ref,
                              Get_Withed_Units =>
                                Data.Tree_Db.Source_Option >= Sources_Units,
                              Success          => Success);
                        end if;
                     end if;
                  end;
               end if;
            end if;
         end;
      end loop;

      GPR2.Build.Source_Base.Ada_Parser.Close (Parser_State);
      --  All source changes have been processed: now resolve potential
      --  visibility issues

      for Base_Name of Changed_Sources loop
         declare
            C_Overload : Basename_Source_List_Maps.Cursor;
         begin
            C_Overload := Data.Overloaded_Srcs.Find (Base_Name);
            Resolve_Visibility (Data, C_Overload, Messages);
         end;
      end loop;

      --  Data.Sources is now updated, we don't need Previous_Files anymore
      Previous_Files.Clear;

      --  Check that we've found all the listed sources
      for S of Data.Listed_Sources loop
         if not Data.Excluded_Sources.Contains (S)
           and then not Data.Sources.Contains (S)
         then
            Messages.Append
              (Message.Create
                 (Message.Error,
                  "source file """ & String (S) & """ not found",
                  (if Data.View.Has_Attribute (PRA.Source_List_File)
                   then Data.View.Attribute (PRA.Source_List_File)
                   else Data.View.Attribute (PRA.Source_Files))));
         end if;
      end loop;

      --  Check that we found all the excluded sources

      for C in Data.Excluded_Sources.Iterate loop
         declare
            Name : constant Filename_Type :=
                     Containers.Source_Path_To_Sloc.Key (C);
            Sloc : constant Source_Reference.Object'Class :=
                     Containers.Source_Path_To_Sloc.Element (C);
         begin
            if Sloc.Is_Defined
              and then not Data.View.Is_Runtime
              and then not Data.Actually_Excluded.Contains (Name)
            then
               Messages.Append
                 (Message.Create
                    (Message.Error,
                     "unknown file """ & String (Name) & '"',
                     Sloc));
            end if;
         end;
      end loop;

      if Data.View.Has_Package (PRP.Naming,
                                Check_Extended => False,
                                With_Defaults  => False,
                                With_Config    => False)
      then
         --  Check all naming exceptions is used only in the original
         --  project where Naming package is declared. If nameing package is
         --  inherited then not all sources from naming exceptions have to
         --  be defined, some of then inherited from extended project.

         for A of Data.View.Attributes
                    (Name          => PRA.Naming.Spec,
                     With_Defaults => False,
                     With_Config   => False)
         loop
            if not Data.Sources.Contains (Simple_Name (A.Value.Text)) then
               Messages.Append
                 (Message.Create
                    ((if Data.View.Has_Attribute (PRA.Source_Files)
                     or else Data.View.Has_Attribute (PRA.Source_List_File)
                     then Message.Warning
                     else Message.Error),
                     "source file """ & A.Value.Text
                     & """ for unit """ & A.Index.Text
                     & """ not found",
                     A.Value));
            end if;
         end loop;

         for A of Data.View.Attributes
                    (Name          => PRA.Naming.Body_N,
                     With_Defaults => False,
                     With_Config   => False)
         loop
            if not Data.Sources.Contains (Simple_Name (A.Value.Text)) then
               Messages.Append
                 (Message.Create
                    ((if Data.View.Has_Attribute (PRA.Source_Files)
                     or else Data.View.Has_Attribute (PRA.Source_List_File)
                     then Message.Warning
                     else Message.Error),
                     "source file """ & A.Value.Text
                     & """ for unit """ & A.Index.Text
                     & """ not found",
                     A.Value));
            end if;
         end loop;

         for Language of Data.View.Language_Ids loop
            if Data.View.Check_Attribute
              (PRA.Naming.Specification_Exceptions,
               Project.Attribute_Index.Create (Language),
               Result => Attr)
            then
               for V of Attr.Values loop
                  if not Data.Sources.Contains (Simple_Name (V.Text)) then
                     Messages.Append
                       (Message.Create
                          (Message.Warning,
                           "source file """ & V.Text & """ not found",
                           V));
                  end if;
               end loop;
            end if;

            if Data.View.Check_Attribute
              (PRA.Naming.Implementation_Exceptions,
               Project.Attribute_Index.Create (Language),
               Result => Attr)
            then
               for V of Attr.Values loop
                  if not Data.Sources.Contains (Simple_Name (V.Text)) then
                     Messages.Append
                       (Message.Create
                          (Message.Warning,
                           "source file """ & V.Text & """ not found",
                           V));
                  end if;
               end loop;
            end if;
         end loop;
      end if;
   end Process;

end Update_Sources_List;