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

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

with Ada.Containers.Hashed_Sets;
with Ada.Strings.Fixed;

with GPR2.Message;
with GPR2.Project.Source.Part_Set;
with GPR2.Project.Definition;
with GPR2.Project.Registry.Attribute;
with GPR2.Project.Source.Artifact;
with GPR2.Project.Source.Set;
with GPR2.Project.Tree;
with GPR2.Project.Unit_Info.Set;
with GPR2.Source_Info.Parser.Registry;

package body GPR2.Project.Source is

   package PRA renames GPR2.Project.Registry.Attribute;
   use type Ada.Containers.Hash_Type;

   function Hash
     (Id : GPR2.Unit.Source_Unit_Identifier) return Ada.Containers.Hash_Type
   is (Ada.Strings.Hash (Id.Source.Value) +
         Ada.Containers.Hash_Type (Id.Index));

   package Source_Unit_Id_Sets is new Ada.Containers.Hashed_Sets
     (GPR2.Unit.Source_Unit_Identifier, Hash, GPR2.Unit."=", GPR2.Unit."=");

   function Change_Actual_View
     (Self : Object; View : Project.View.Object) return Object
     with Pre => Self.Is_Defined and then View.Is_Defined;
   --  Returns Object with changed actual view for the case when source was
   --  derived from extended project.

   ----------------
   -- Aggregated --
   ----------------

   function Aggregated (Self : Object) return Project.View.Object is
   begin
      return (if Self.Is_Aggregated
              then Definition.Strong (Self.Aggregated)
              else Project.View.Undefined);
   end Aggregated;

   -----------------------
   -- Aggregating_Views --
   -----------------------

   function Aggregating_Views (Self : Object) return Project.View.Set.Object is
   begin
      return Definition.Strong (Self.View).Aggregate_Libraries;
   end Aggregating_Views;

   ---------------
   -- Artifacts --
   ---------------

   function Artifacts
     (Self : Object; Force_Spec : Boolean := False) return Artifact.Object is
   begin
      return Artifact.Create (Self, Force_Spec => Force_Spec);
   end Artifacts;

   ------------------------
   -- Change_Actual_View --
   ------------------------

   function Change_Actual_View
     (Self : Object; View : Project.View.Object) return Object is
   begin
      return Result : Object := Self do
         Result.View      := Definition.Weak (View);
         Result.Inherited := True;
      end return;
   end Change_Actual_View;

   ------------
   -- Create --
   ------------

   function Create
     (Source           : GPR2.Source.Object;
      View             : Project.View.Object;
      Naming_Exception : Naming_Exception_Kind;
      Is_Compilable    : Boolean;
      Aggregated       : Project.View.Object := Project.View.Undefined)
      return Object is
   begin
      return Result : Object :=
        Object'
          (Source with
           Definition.Weak (View),
           Naming_Exception => Naming_Exception,
           Is_Compilable    => Is_Compilable,
           others           => <>)
      do
         if Aggregated.Is_Defined then
            Result.Aggregated := Definition.Weak (Aggregated);
         end if;
      end return;
   end Create;

   ------------------
   -- Dependencies --
   ------------------

   function Dependencies
     (Self    : Object;
      Index   : Unit_Index := No_Index;
      Closure : Boolean    := False;
      Sorted  : Boolean    := True) return Part_Set.Object
   is
      Deps : Part_Set.Object (Sorted => Sorted);

      procedure Insert
        (Source    : Object;
         Unit      : GPR2.Unit.Object;
         Timestamp : Ada.Calendar.Time);

      ------------
      -- Insert --
      ------------

      procedure Insert
        (Source    : Object;
         Unit      : GPR2.Unit.Object;
         Timestamp : Ada.Calendar.Time)
      is
         pragma Unreferenced (Timestamp);
      begin
         if Unit.Is_Defined then
            Deps.Insert ((Source, Unit.Index));
         else
            Deps.Insert ((Source, No_Index));
         end if;

      end Insert;

   begin
      Self.Dependencies (Index, Insert'Access, Closure, Sorted);
      return Deps;
   end Dependencies;

   procedure Dependencies
     (Self     : Object;
      Index    : Unit_Index;
      For_Each : not null access procedure
                   (Source    : Object;
                    Unit      : GPR2.Unit.Object;
                    Timestamp : Ada.Calendar.Time);
      Closure  : Boolean := False;
      Sorted   : Boolean := True)
   is
      use type GPR2.Source_Info.Backend;

      Tree   : constant not null access Project.Tree.Object :=
                    View (Self).Tree;
      Done   : Source_Unit_Id_Sets.Set;
      Added  : Part_Set.Object (Sorted => Sorted);

      procedure Analyze_With_Clauses (Src : Source_Part);
      --  Retrieve the dependencies from with clauses

      procedure Handle_Dependency
        (Source    : Object;
         Index     : Unit_Index;
         Timestamp : Ada.Calendar.Time);
      --  Add the dependency to the result

      procedure On_Dependency
        (Unit_Name : Name_Type;
         Sfile     : Simple_Name;
         Kind      : GPR2.Unit.Library_Unit_Type;
         Stamp     : Ada.Calendar.Time);
      --  Callback when iterating on Source_Info.Dependencies

      --------------------------
      -- Analyze_With_Clauses --
      --------------------------

      procedure Analyze_With_Clauses (Src : Source_Part) is
         CU : GPR2.Unit.Object renames Src.Source.Unit (Src.Index);
      begin
         for W of CU.Dependencies loop
            declare
               V  : constant Project.View.Object :=
                      Tree.Get_View (W);
               UI : Unit_Info.Object;
            begin
               if not V.Is_Defined then
                  Tree.Log_Messages.Append
                    (Message.Create
                       (Message.Warning,
                        "withed unit " & String (W) & " not found",
                        Source_Reference.Create
                          (Filename => Src.Source.Path_Name.Value,
                           Line     => 0,
                           Column   => 0)));

               else
                  UI := Definition.Get_RO (V).Units (W);

                  if not Closure then
                     if UI.Has_Spec then
                        Handle_Dependency
                          (V.Source (UI.Spec.Source),
                           UI.Spec.Index,
                           No_Time);

                     elsif UI.Has_Body then
                        Handle_Dependency
                          (V.Source (UI.Main_Body.Source),
                           UI.Main_Body.Index,
                           No_Time);
                     end if;

                  else
                     if UI.Has_Spec then
                        Handle_Dependency
                          (V.Source (UI.Spec.Source),
                           UI.Spec.Index,
                           No_Time);
                     end if;

                     if UI.Has_Body then
                        Handle_Dependency
                          (V.Source (UI.Main_Body.Source),
                           UI.Main_Body.Index,
                           No_Time);
                     end if;

                     for Sep of UI.Separates loop
                        Handle_Dependency
                          (V.Source (Sep.Source),
                           Sep.Index,
                           No_Time);
                     end loop;
                  end if;
               end if;
            end;
         end loop;
      end Analyze_With_Clauses;

      -----------------------
      -- Handle_Dependency --
      -----------------------

      procedure Handle_Dependency
        (Source    : Object;
         Index     : Unit_Index;
         Timestamp : Ada.Calendar.Time)
      is
         Position : Source_Unit_Id_Sets.Cursor;
         Inserted : Boolean;
      begin
         Done.Insert ((Source.Path_Name, Index), Position, Inserted);

         if Inserted then
            if Closure then
               Added.Insert ((Source, Index));
            end if;

            if Source.Has_Units then
               For_Each (Source, Source.Unit (Index), Timestamp);
            else
               For_Each (Source, GPR2.Unit.Undefined, Timestamp);
            end if;
         end if;
      end Handle_Dependency;

      -------------------
      -- On_Dependency --
      -------------------

      procedure On_Dependency
        (Unit_Name : Name_Type;
         Sfile     : Simple_Name;
         Kind      : GPR2.Unit.Library_Unit_Type;
         Stamp     : Ada.Calendar.Time)
      is
         S  : Project.Source.Constant_Access;
         CU : GPR2.Unit.Object;

      begin
         if not View (Self).Check_Source (Sfile, S) then
            return;
         end if;

         if S.Has_Units
           and then S.Check_Unit
             (Unit_Name, Spec => Kind in GPR2.Unit.Spec_Kind, Unit => CU)
         then
            Handle_Dependency (S.all, CU.Index, Stamp);
         else
            Handle_Dependency (S.all, No_Index, Stamp);
         end if;
      end On_Dependency;

   begin
      if not Self.Is_Parsed (Index) then
         return;
      end if;

      if Self.Used_Backend (Index) = Source_Info.LI then
         --  Dependencies will be retrieved from LI information for the
         --  source file.
         Added.Insert ((Self, Index));
      else
         --  Gather the withed units from the compilation unit: spec + body
         --  + separates.
         declare
            V    : constant Project.View.Object := View (Self);
            Def  : constant Definition.Const_Ref :=
                     Definition.Get_RO (View (Self));
            Unit : constant GPR2.Unit.Object := Self.Unit (Index);
            UI   : constant Unit_Info.Object :=
                     Def.Units.Element (if Unit.Kind = GPR2.Unit.S_Separate
                                        then Unit.Separate_From
                                        else Unit.Name);
         begin
            if UI.Has_Spec then
               if not Closure then
                  --  In closure mode, Handle_Directory will add the source
                  --  there.
                  Added.Insert ((V.Source (UI.Spec.Source), UI.Spec.Index));
               end if;

               --  Add explicitly the compilation unit, as the with clauses
               --  won't list them (but they're still dependencies).
               Handle_Dependency
                 (V.Source (UI.Spec.Source), UI.Spec.Index, No_Time);
            end if;

            if UI.Has_Body then
               if not Closure then
                  Added.Insert
                    ((V.Source (UI.Main_Body.Source), UI.Main_Body.Index));
               end if;

               Handle_Dependency
                 (V.Source (UI.Main_Body.Source), UI.Main_Body.Index, No_Time);
            end if;

            for Sep of UI.Separates loop
               if not Closure then
                  Added.Insert ((V.Source (Sep.Source), Sep.Index));
               end if;
               Handle_Dependency
                 (V.Source (Sep.Source), Sep.Index, No_Time);
            end loop;
         end;
      end if;

      while not Added.Is_Empty loop
         declare
            Set : constant Part_Set.Object := Added;
         begin
            Added.Clear;

            for Src_Part of Set loop
               if Src_Part.Source.Is_Parsed (Src_Part.Index) then
                  if Src_Part.Source.Used_Backend (Src_Part.Index) =
                    GPR2.Source_Info.LI
                  then
                     --  Get the dependencies directly from the dependency
                     --  file.

                     Src_Part.Source.Dependencies
                       (Src_Part.Index,
                        On_Dependency'Access);

                  elsif Src_Part.Source.Has_Units then
                     --  No dependency file: use the source parser to gather
                     --  the list of withed units.

                     Analyze_With_Clauses (Src_Part);
                  end if;
               end if;
            end loop;
         end;
      end loop;
   end Dependencies;

   procedure Dependencies
     (Self     : Object;
      Index    : Unit_Index;
      For_Each : not null access procedure
                   (Source    : Object;
                    Index     : Unit_Index;
                    Timestamp : Ada.Calendar.Time);
      Closure  : Boolean := False;
      Sorted   : Boolean := True)
   is
      procedure Action (Source    : Object;
                        Unit      : GPR2.Unit.Object;
                        Timestamp : Ada.Calendar.Time);

      ------------
      -- Action --
      ------------

      procedure Action (Source    : Object;
                        Unit      : GPR2.Unit.Object;
                        Timestamp : Ada.Calendar.Time) is
      begin
         if Unit.Is_Defined then
            For_Each (Source, Unit.Index, Timestamp);
         else
            For_Each (Source, No_Index, Timestamp);
         end if;
      end Action;

   begin
      Self.Dependencies
        (Index, Action'Access, Closure => Closure, Sorted => Sorted);
   end Dependencies;

   --------------------------
   -- Has_Aggregating_View --
   --------------------------

   function Has_Aggregating_View (Self : Object) return Boolean is
   begin
      return Definition.Strong (Self.View).Is_Aggregated_In_Library;
   end Has_Aggregating_View;

   --------------------
   -- Has_Other_Part --
   --------------------

   function Has_Other_Part
     (Self  : Object;
      Index : Unit_Index := No_Index) return Boolean
   is
      View : constant Project.View.Object  :=
               Definition.Strong (Self.View);
      Data : constant Definition.Const_Ref := Definition.Get_RO (View);
   begin
      if Self.Has_Units
        and then Self.Has_Unit_At (Index)
        and then Self.Units.Length >= Containers.Count_Type (Index)
      then
         declare
            use GPR2.Unit;
            CU     : constant GPR2.Unit.Object := Self.Unit (Index);
            Kind   : constant GPR2.Unit.Library_Unit_Type := CU.Kind;
            C_Unit : constant Unit_Info.Set.Cursor :=
                       Data.Units.Find
                         (if Kind = S_Separate
                          then CU.Separate_From
                          else CU.Name);
         begin
            if Unit_Info.Set.Set.Has_Element (C_Unit) then
               declare
                  Unit : constant Unit_Info.Set.Set.Constant_Reference_Type :=
                           Data.Units (C_Unit);
               begin
                  case Kind is
                     when Body_Kind =>
                        return Unit.Spec.Source.Is_Defined;

                     when Spec_Kind =>
                        return Unit.Main_Body.Source.Is_Defined;

                     when S_Separate =>
                        return Unit.Spec.Source.Is_Defined
                          or else Unit.Main_Body.Source.Is_Defined;
                  end case;
               end;
            end if;
         end;
      end if;

      return False;
   end Has_Other_Part;

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

   function Is_Compilable (Self : Object) return Boolean is
   begin
      return Self.Is_Compilable;
   end Is_Compilable;

   ------------------
   -- Is_Interface --
   ------------------

   function Is_Interface (Self : Object) return Boolean is
      Def : constant Definition.Const_Ref :=
              Definition.Get_RO (View (Self));
   begin
      if Def.Interface_Sources.Contains (Self.Path_Name.Simple_Name) then

         return True;

      elsif Self.Has_Units then
         for CU of Self.Units loop
            if Def.Interface_Units.Contains (CU.Name) then
               return True;
            end if;
         end loop;
      end if;

      return False;
   end Is_Interface;

   -------------
   -- Is_Main --
   -------------

   function Is_Main (Self : Object) return Boolean is
   begin
      return Definition.Strong (Self.View).Is_Main (Self);
   end Is_Main;

   ----------------
   -- Other_Part --
   ----------------

   function Other_Part
     (Self  : Object;
      Index : Unit_Index := No_Index) return Source_Part
   is
      use GPR2.Unit;
      View      : constant Project.View.Object :=
                    Definition.Strong (Self.View);
      CU        : constant GPR2.Unit.Object := Self.Unit (Index);
      Kind      : constant GPR2.Unit.Library_Unit_Type := CU.Kind;
      Unit_Name : constant Name_Type :=
                          (if Kind = S_Separate
                           then CU.Separate_From
                           else CU.Name);
      Unit      : constant Unit_Info.Object := View.Unit (Unit_Name);
   begin
      case Kind is
         when GPR2.Unit.Body_Kind =>
            return (View.Source (Unit.Spec.Source), Unit.Spec.Index);

         when GPR2.Unit.Spec_Kind =>
            return (View.Source (Unit.Main_Body.Source),
                    Unit.Main_Body.Index);

         when S_Separate =>
            if Unit.Spec.Source.Is_Defined then
               return (View.Source (Unit.Spec.Source), Unit.Spec.Index);
            else
               return (View.Source (Unit.Main_Body.Source),
                       Unit.Main_Body.Index);
            end if;
      end case;
   end Other_Part;

   --------------------------
   -- Other_Part_Unchecked --
   --------------------------

   function Other_Part_Unchecked
     (Self  : Object;
      Index : Unit_Index) return Source_Part
   is
      View : constant Project.View.Object  :=
               Definition.Strong (Self.View);
      Data : constant Definition.Const_Ref := Definition.Get_RO (View);
   begin
      if Self.Has_Units
        and then Self.Units.Length >= Containers.Count_Type (Index)
      then
         declare
            use GPR2.Unit;
            CU     : constant GPR2.Unit.Object := Self.Unit (Index);
            Kind   : constant GPR2.Unit.Library_Unit_Type := CU.Kind;
            C_Unit : constant Unit_Info.Set.Cursor :=
                       Data.Units.Find
                         (if Kind = S_Separate
                          then CU.Separate_From
                          else CU.Name);
         begin
            if Unit_Info.Set.Set.Has_Element (C_Unit) then
               declare
                  Unit : constant Unit_Info.Set.Set.Constant_Reference_Type :=
                           Data.Units (C_Unit);
               begin
                  case Kind is
                     when GPR2.Unit.Body_Kind =>
                        if Unit.Spec.Source.Is_Defined then
                           return (View.Source (Unit.Spec.Source),
                                   Unit.Spec.Index);
                        end if;

                     when GPR2.Unit.Spec_Kind =>
                        if Unit.Main_Body.Source.Is_Defined then
                           return (View.Source (Unit.Main_Body.Source),
                                   Unit.Main_Body.Index);
                        end if;

                     when S_Separate =>
                        if Unit.Main_Body.Source.Is_Defined then
                           return (View.Source (Unit.Main_Body.Source),
                                   Unit.Main_Body.Index);
                        elsif Unit.Spec.Source.Is_Defined then
                           return (View.Source (Unit.Spec.Source),
                                   Unit.Spec.Index);
                        end if;
                  end case;
               end;
            end if;
         end;
      end if;

      return (Undefined, No_Index);
   end Other_Part_Unchecked;

   -------------------
   -- Separate_From --
   -------------------

   function Separate_From
     (Self  : Object;
      Index : Unit_Index) return Source_Part
   is
      View      : constant Project.View.Object  :=
                    Definition.Strong (Self.View);
      CU        : constant GPR2.Unit.Object := Self.Unit (Index);
      Unit_Name : constant Name_Type := CU.Separate_From;
      Unit      : constant Unit_Info.Object := View.Unit (Unit_Name);
   begin
      if Unit.Has_Spec then
         return (View.Source (Unit.Spec.Source), Unit.Spec.Index);
      else
         return (View.Source (Unit.Main_Body.Source), Unit.Main_Body.Index);
      end if;
   end Separate_From;

   ------------
   -- Update --
   ------------

   procedure Update
     (Self     : in out Object;
      Backends : Source_Info.Backend_Set := Source_Info.All_Backends)
   is
      Def : constant Definition.Ref :=
              Definition.Get (Definition.Strong (Self.View));
      C   : constant Project.Source.Set.Cursor :=
              Def.Sources.Find (Self);
   begin
      pragma Assert (Project.Source.Set.Has_Element (C));
      Self.Update (C, Backends);
   end Update;

   ------------
   -- Update --
   ------------

   procedure Update
     (Self     : in out Object;
      C        : Project.Source.Set.Cursor;
      Backends : Source_Info.Backend_Set := Source_Info.All_Backends)
   is
      use type GPR2.Source_Info.Parse_State;
      Language : constant Language_Id := Self.Language;
      Def      : constant Definition.Ref :=
                   Definition.Get (Definition.Strong (Self.View));

      procedure Clarify_Unit_Type;
      --  Set Kind to Spec_Only for the units without body and
      --  set Kind to S_Body_Only for the units without specification.

      -----------------------
      -- Clarify_Unit_Type --
      -----------------------

      procedure Clarify_Unit_Type is
         use Definition;
      begin
         for U of Self.Units loop
            declare
               use GPR2.Unit;
               package US renames Unit_Info.Set.Set;

               CU : constant Project.Unit_Info.Set.Cursor :=
                       Def.Units.Find (U.Name);

            begin
               if not US.Has_Element (CU) then
                  if Self.Is_Runtime then
                     return;
                  end if;

                  if Is_Runtime_Unit_Name (U.Name) then
                     --  Try to find possible runtime unit name and fix unit
                     --  name.

                     declare
                        DR : constant String :=
                               View (Self).Attribute
                                 (PRA.Naming.Dot_Replacement).Value.Text;
                        SN : constant String :=
                               String (Self.Path_Name.Simple_Name);
                        CU : Project.Unit_Info.Set.Cursor;
                     begin
                        if SN (SN'First + 1 .. SN'First + DR'Length) = DR then
                           CU := Def.Units.Find
                             (Name_Type
                                (Ada.Strings.Fixed.Replace_Slice
                                   (SN, SN'First + 1, SN'First + DR'Length,
                                    ".")));

                           if US.Has_Element (CU) then
                              Def.Units (CU).Update_Name (U.Name);
                              Def.Units.Insert (U.Name, US.Element (CU));
                              Def.Units.Delete (CU);
                           end if;
                        end if;
                     end;
                  end if;

                  return;
               end if;

               if U.Kind = S_Spec and then not US.Element (CU).Has_Body then
                  Self.Update_Kind (S_Spec_Only, U.Index);

               elsif U.Kind = S_Body and then not US.Element (CU).Has_Spec then
                  Self.Update_Kind (S_Body_Only, U.Index);
               end if;
            end;
         end loop;
      end Clarify_Unit_Type;

   begin
      if Self.Is_Parsed = Source_Info.Full then
         return;
      end if;

      for BK in Backends'Range loop
         if Backends (BK)
           and then Source_Info.Parser.Registry.Exists (Language, BK)
         then
            declare
               use type Source_Info.Implemented_Backend;

               Backend : constant not null access
                 Source_Info.Parser.Object'Class :=
                   Source_Info.Parser.Registry.Get (Language, BK);
            begin
               if BK = Source_Info.LI and then Self.Has_Units then
                  --  Need to clarify unit type before call to ALI parser to
                  --  detect when spec only Ada source has related ALI file.

                  Clarify_Unit_Type;
               end if;

               --  Ada source parser is not compatible with multi-unit
               --  sources.

               if not (BK = Source_Info.Source
                       and then Self.Has_Units
                       and then Self.Has_Index)
               then
                  Source_Info.Parser.Compute
                    (Self   => Backend,
                     Data   => Self,
                     Source => Self);
               end if;

               exit when Self.Is_Parsed = Source_Info.Full;
            end;
         end if;
      end loop;

      if Self.Has_Units then
         Clarify_Unit_Type;

         declare
            CUnits   : GPR2.Project.Unit_Info.Set.Cursor;
            Inserted : Boolean;
         begin
            --  Check newly found separates and update Unit_Info
            for Unit of Self.Units loop
               declare
                  Unit_Name : constant Name_Type :=
                                (if Unit.Kind = GPR2.Unit.S_Separate
                                 then Unit.Separate_From
                                 else Unit.Name);
               begin
                  Def.Units.Insert
                    (Unit_Name,
                     Unit_Info.Create (Unit_Name),
                     CUnits,
                     Inserted);
               end;

               declare
                  SUI : constant GPR2.Unit.Source_Unit_Identifier :=
                          (Self.Path_Name, Unit.Index);
                  Ref : constant Unit_Info.Set.Set.Reference_Type :=
                          Def.Units.Reference (CUnits);

                  use type GPR2.Unit.Library_Item_Type;

               begin
                  if Unit.Kind in GPR2.Unit.Spec_Kind
                    and then not Ref.Has_Spec
                  then
                     Ref.Update_Spec (SUI);

                  elsif Unit.Kind in GPR2.Unit.Body_Kind
                    and then not Ref.Has_Body
                    and then Unit.Library_Item_Kind /= GPR2.Unit.Is_No_Body
                  then
                     Ref.Update_Body (SUI);

                  elsif Unit.Kind = GPR2.Unit.S_Separate then
                     Ref.Update_Separates (SUI);
                  end if;
               end;

               Def.Units_Map.Include (Definition.Key (Unit), C);
            end loop;
         end;
      end if;

      Def.Sources.Replace (C, Self);
   end Update;

   ----------
   -- View --
   ----------

   function View (Self : Object) return Project.View.Object is
   begin
      return Definition.Strong (Self.View);
   end View;

begin
   Definition.Change_Actual_View := Change_Actual_View'Access;
end GPR2.Project.Source;