-- --
-- B o d y --
-- --
--- Copyright (C) 2000-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
with Prj.Util; use Prj.Util;
with Sinput.P;
with Snames; use Snames;
-with Targparm; use Targparm;
+with Ada; use Ada;
with Ada.Characters.Handling; use Ada.Characters.Handling;
-with Ada.Directories; use Ada, Ada.Directories;
+with Ada.Directories; use Ada.Directories;
with Ada.Strings; use Ada.Strings;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
Hash => Hash,
Equal => "=");
-- File name information found in string list attribute (Source_Files or
- -- Source_List_File). Except is set to True if source is a naming exception
- -- in the project. Used to check that all referenced files were indeed
+ -- Source_List_File). Used to check that all referenced files were indeed
-- found on the disk.
type Unit_Exception is record
end record;
No_File_Found : constant File_Found :=
- (No_File, No_File, 0, False, No_Location);
+ (No_File, No_File, 0, False, No_Location);
package Excluded_Sources_Htable is new GNAT.Dynamic_HTables.Simple_HTable
(Header_Num => Header_Num,
-- be discarded as soon as we have finished processing the project
type Tree_Processing_Data is record
- Tree : Project_Tree_Ref;
- Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
- Flags : Prj.Processing_Flags;
+ Tree : Project_Tree_Ref;
+ Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
+ Flags : Prj.Processing_Flags;
+ In_Aggregate_Lib : Boolean;
end record;
-- Temporary data which is needed while parsing a project. It does not need
-- to be kept in memory once a project has been fully loaded, but is
type Lib_Data is record
Name : Name_Id;
Proj : Project_Id;
+ Tree : Project_Tree_Ref;
end record;
package Lib_Data_Table is new GNAT.Table
procedure Free (Data : in out Tree_Processing_Data);
-- Free the memory occupied by Data
- procedure Check
- (Project : Project_Id;
- Data : in out Tree_Processing_Data);
- -- Process the naming scheme for a single project
-
procedure Initialize
(Data : in out Project_Processing_Data;
Project : Project_Id);
-- otherwise only those currently set in the Source_Names hash table.
procedure Check_File_Naming_Schemes
- (In_Tree : Project_Tree_Ref;
- Project : Project_Processing_Data;
+ (Project : Project_Processing_Data;
File_Name : File_Name_Type;
Alternate_Languages : out Language_List;
Language : out Language_Ptr;
Naming : Lang_Naming_Data;
Kind : out Source_Kind;
Unit : out Name_Id;
- Project : Project_Processing_Data;
- In_Tree : Project_Tree_Ref);
+ Project : Project_Processing_Data);
-- Check whether the file matches the naming scheme. If it does,
-- compute its unit name. If Unit is set to No_Name on exit, none of the
-- other out parameters are relevant.
while J <= Str'Last loop
Name_Len := Name_Len + 1;
- if J <= Max
- and then Str (J .. J + Pattern'Length - 1) = Pattern
- then
+ if J <= Max and then Str (J .. J + Pattern'Length - 1) = Pattern then
Name_Buffer (Name_Len) := Replacement;
J := J + Pattern'Length;
-
else
Name_Buffer (Name_Len) := GNAT.Case_Util.To_Lower (Str (J));
J := J + 1;
Canonical_Case_File_Name (Suf);
-- The file name must end with the suffix (which is not an extension)
- -- For instance a suffix "configure.in" must match a file with the
+ -- For instance a suffix "configure.ac" must match a file with the
-- same name. To avoid dummy cases, though, a suffix starting with
-- '.' requires a file that is at least one character longer ('.cpp'
-- should not match a file with the same name).
end if;
end if;
- -- Duplication of file/unit in same project is allowed if order of
- -- source directories is known, or if there is no compiler for the
- -- language.
+ -- Always add the source if it is locally removed, to avoid incorrect
+ -- duplicate checks.
- if Add_Src = False then
+ if Locally_Removed then
Add_Src := True;
- if Project = Source.Project then
- if Prev_Unit = No_Unit_Index then
- if Data.Flags.Allow_Duplicate_Basenames then
- Add_Src := True;
+ -- A locally removed source may first replace a source in a project
+ -- being extended.
+
+ if Source /= No_Source
+ and then Is_Extending (Project, Source.Project)
+ and then Naming_Exception /= Inherited
+ then
+ Source_To_Replace := Source;
+ end if;
- elsif Lang_Id.Config.Compiler_Driver = Empty_File then
- Add_Src := True;
+ else
+ -- Duplication of file/unit in same project is allowed if order of
+ -- source directories is known, or if there is no compiler for the
+ -- language.
- elsif Source_Dir_Rank /= Source.Source_Dir_Rank then
- Add_Src := False;
+ if Add_Src = False then
+ Add_Src := True;
- else
- Error_Msg_File_1 := File_Name;
- Error_Msg
- (Data.Flags, "duplicate source file name {",
- Location, Project);
- Add_Src := False;
- end if;
+ if Project = Source.Project then
+ if Prev_Unit = No_Unit_Index then
+ if Data.Flags.Allow_Duplicate_Basenames then
+ Add_Src := True;
- else
- if Source_Dir_Rank /= Source.Source_Dir_Rank then
- Add_Src := False;
+ elsif Lang_Id.Config.Compiler_Driver = Empty_File then
+ Add_Src := True;
- -- We might be seeing the same file through a different path
- -- (for instance because of symbolic links).
+ elsif Source_Dir_Rank /= Source.Source_Dir_Rank then
+ Add_Src := False;
- elsif Source.Path.Name /= Path.Name then
- if not Source.Duplicate_Unit then
- Error_Msg_Name_1 := Unit;
+ else
+ Error_Msg_File_1 := File_Name;
Error_Msg
- (Data.Flags, "\duplicate unit %%", Location, Project);
- Source.Duplicate_Unit := True;
+ (Data.Flags, "duplicate source file name {",
+ Location, Project);
+ Add_Src := False;
end if;
- Add_Src := False;
+ else
+ if Source_Dir_Rank /= Source.Source_Dir_Rank then
+ Add_Src := False;
+
+ -- We might be seeing the same file through a different
+ -- path (for instance because of symbolic links).
+
+ elsif Source.Path.Name /= Path.Name then
+ if not Source.Duplicate_Unit then
+ Error_Msg_Name_1 := Unit;
+ Error_Msg
+ (Data.Flags,
+ "\duplicate unit %%",
+ Location,
+ Project);
+ Source.Duplicate_Unit := True;
+ end if;
+
+ Add_Src := False;
+ end if;
end if;
- end if;
- -- Do not allow the same unit name in different projects, except
- -- if one is extending the other.
+ -- Do not allow the same unit name in different projects,
+ -- except if one is extending the other.
- -- For a file based language, the same file name replaces a file
- -- in a project being extended, but it is allowed to have the same
- -- file name in unrelated projects.
+ -- For a file based language, the same file name replaces a
+ -- file in a project being extended, but it is allowed to have
+ -- the same file name in unrelated projects.
- elsif Is_Extending (Project, Source.Project) then
- if not Locally_Removed and then Naming_Exception /= Inherited then
- Source_To_Replace := Source;
- end if;
+ elsif Is_Extending (Project, Source.Project) then
+ if not Locally_Removed and then Naming_Exception /= Inherited
+ then
+ Source_To_Replace := Source;
+ end if;
- elsif Prev_Unit /= No_Unit_Index
- and then Prev_Unit.File_Names (Kind) /= null
- and then not Source.Locally_Removed
- then
- -- Path is set if this is a source we found on the disk, in which
- -- case we can provide more explicit error message. Path is unset
- -- when the source is added from one of the naming exceptions in
- -- the project.
+ elsif Prev_Unit /= No_Unit_Index
+ and then Prev_Unit.File_Names (Kind) /= null
+ and then not Source.Locally_Removed
+ and then Source.Replaced_By = No_Source
+ and then not Data.In_Aggregate_Lib
+ then
+ -- Path is set if this is a source we found on the disk, in
+ -- which case we can provide more explicit error message. Path
+ -- is unset when the source is added from one of the naming
+ -- exceptions in the project.
- if Path /= No_Path_Information then
- Error_Msg_Name_1 := Unit;
- Error_Msg
- (Data.Flags,
- "unit %% cannot belong to several projects",
- Location, Project);
+ if Path /= No_Path_Information then
+ Error_Msg_Name_1 := Unit;
+ Error_Msg
+ (Data.Flags,
+ "unit %% cannot belong to several projects",
+ Location, Project);
- Error_Msg_Name_1 := Project.Name;
- Error_Msg_Name_2 := Name_Id (Path.Display_Name);
- Error_Msg
- (Data.Flags, "\ project %%, %%", Location, Project);
+ Error_Msg_Name_1 := Project.Name;
+ Error_Msg_Name_2 := Name_Id (Path.Display_Name);
+ Error_Msg
+ (Data.Flags, "\ project %%, %%", Location, Project);
- Error_Msg_Name_1 := Source.Project.Name;
- Error_Msg_Name_2 := Name_Id (Source.Path.Display_Name);
- Error_Msg
- (Data.Flags, "\ project %%, %%", Location, Project);
+ Error_Msg_Name_1 := Source.Project.Name;
+ Error_Msg_Name_2 := Name_Id (Source.Path.Display_Name);
+ Error_Msg
+ (Data.Flags, "\ project %%, %%", Location, Project);
- else
- Error_Msg_Name_1 := Unit;
- Error_Msg_Name_2 := Source.Project.Name;
- Error_Msg
- (Data.Flags, "unit %% already belongs to project %%",
- Location, Project);
- end if;
+ else
+ Error_Msg_Name_1 := Unit;
+ Error_Msg_Name_2 := Source.Project.Name;
+ Error_Msg
+ (Data.Flags, "unit %% already belongs to project %%",
+ Location, Project);
+ end if;
- Add_Src := False;
+ Add_Src := False;
- elsif not Source.Locally_Removed
- and then not Data.Flags.Allow_Duplicate_Basenames
- and then Lang_Id.Config.Kind = Unit_Based
- and then Source.Language.Config.Kind = Unit_Based
- then
- Error_Msg_File_1 := File_Name;
- Error_Msg_File_2 := File_Name_Type (Source.Project.Name);
- Error_Msg
- (Data.Flags,
- "{ is already a source of project {", Location, Project);
+ elsif not Source.Locally_Removed
+ and then Source.Replaced_By /= No_Source
+ and then not Data.Flags.Allow_Duplicate_Basenames
+ and then Lang_Id.Config.Kind = Unit_Based
+ and then Source.Language.Config.Kind = Unit_Based
+ and then not Data.In_Aggregate_Lib
+ then
+ Error_Msg_File_1 := File_Name;
+ Error_Msg_File_2 := File_Name_Type (Source.Project.Name);
+ Error_Msg
+ (Data.Flags,
+ "{ is already a source of project {", Location, Project);
- -- Add the file anyway, to avoid further warnings like "language
- -- unknown".
+ -- Add the file anyway, to avoid further warnings like
+ -- "language unknown".
- Add_Src := True;
+ Add_Src := True;
+ end if;
end if;
end if;
-- Note that this updates Unit information as well
- if Naming_Exception /= Inherited then
+ if Naming_Exception /= Inherited and then not Locally_Removed then
Override_Kind (Id, Kind);
end if;
end if;
Flags : Processing_Flags)
is
Data : Tree_Processing_Data :=
- (Tree => Tree,
- Node_Tree => Node_Tree,
- Flags => Flags);
+ (Tree => Tree,
+ Node_Tree => Node_Tree,
+ Flags => Flags,
+ In_Aggregate_Lib => False);
Project_Files : constant Prj.Variable_Value :=
Prj.Util.Value_Of
-- Start of processing for Check_Aggregate_Project
begin
- pragma Assert (Project.Qualifier = Aggregate);
+ pragma Assert (Project.Qualifier in Aggregate_Project);
if Project_Files.Default then
Error_Msg_Name_1 := Snames.Name_Project_Files;
Free (Project_Path_For_Aggregate);
end Process_Aggregated_Projects;
- -----------
- -- Check --
- -----------
-
- procedure Check
- (Project : Project_Id;
- Data : in out Tree_Processing_Data)
- is
- Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
- Prj_Data : Project_Processing_Data;
-
- begin
- Debug_Increase_Indent ("check", Project.Name);
-
- Initialize (Prj_Data, Project);
-
- Check_If_Externally_Built (Project, Data);
-
- if Project.Qualifier /= Aggregate then
- Get_Directories (Project, Data);
- Check_Programming_Languages (Project, Data);
-
- if Current_Verbosity = High then
- Show_Source_Dirs (Project, Shared);
- end if;
- end if;
-
- case Project.Qualifier is
- when Dry => Check_Abstract_Project (Project, Data);
- when others => null;
- end case;
-
- -- Check configuration. This must be done even for gnatmake (even though
- -- no user configuration file was provided) since the default config we
- -- generate indicates whether libraries are supported for instance.
-
- Check_Configuration (Project, Data);
-
- if Project.Qualifier /= Aggregate then
- Check_Library_Attributes (Project, Data);
- Check_Package_Naming (Project, Data);
- Look_For_Sources (Prj_Data, Data);
- Check_Interfaces (Project, Data);
-
- if Project.Library then
- Check_Stand_Alone_Library (Project, Data);
- end if;
-
- Get_Mains (Project, Data);
- end if;
-
- Free (Prj_Data);
-
- Debug_Decrease_Indent ("done check");
- end Check;
-
----------------------------
-- Check_Abstract_Project --
----------------------------
Element : Package_Element;
procedure Process_Binder (Arrays : Array_Id);
- -- Process the associate array attributes of package Binder
+ -- Process the associated array attributes of package Binder
procedure Process_Builder (Attributes : Variable_Id);
-- Process the simple attributes of package Builder
+ procedure Process_Clean (Attributes : Variable_Id);
+ -- Process the simple attributes of package Clean
+
+ procedure Process_Clean (Arrays : Array_Id);
+ -- Process the associated array attributes of package Clean
+
procedure Process_Compiler (Arrays : Array_Id);
- -- Process the associate array attributes of package Compiler
+ -- Process the associated array attributes of package Compiler
procedure Process_Naming (Attributes : Variable_Id);
-- Process the simple attributes of package Naming
procedure Process_Naming (Arrays : Array_Id);
- -- Process the associate array attributes of package Naming
+ -- Process the associated array attributes of package Naming
procedure Process_Linker (Attributes : Variable_Id);
-- Process the simple attributes of package Linker of a
end loop;
end Process_Builder;
+ -------------------
+ -- Process_Clean --
+ -------------------
+
+ procedure Process_Clean (Attributes : Variable_Id) is
+ Attribute_Id : Variable_Id;
+ Attribute : Variable;
+ List : String_List_Id;
+
+ begin
+ -- Process non associated array attributes from package Clean
+
+ Attribute_Id := Attributes;
+ while Attribute_Id /= No_Variable loop
+ Attribute := Shared.Variable_Elements.Table (Attribute_Id);
+
+ if not Attribute.Value.Default then
+ if Attribute.Name = Name_Artifacts_In_Exec_Dir then
+
+ -- Attribute Artifacts_In_Exec_Dir: the list of file
+ -- names to be cleaned in the exec dir of the main
+ -- project.
+
+ List := Attribute.Value.Values;
+
+ if List /= Nil_String then
+ Put (Into_List =>
+ Project.Config.Artifacts_In_Exec_Dir,
+ From_List => List,
+ In_Tree => Data.Tree);
+ end if;
+
+ elsif Attribute.Name = Name_Artifacts_In_Object_Dir then
+
+ -- Attribute Artifacts_In_Exec_Dir: the list of file
+ -- names to be cleaned in the object dir of every
+ -- project.
+
+ List := Attribute.Value.Values;
+
+ if List /= Nil_String then
+ Put (Into_List =>
+ Project.Config.Artifacts_In_Object_Dir,
+ From_List => List,
+ In_Tree => Data.Tree);
+ end if;
+ end if;
+ end if;
+
+ Attribute_Id := Attribute.Next;
+ end loop;
+ end Process_Clean;
+
+ procedure Process_Clean (Arrays : Array_Id) is
+ Current_Array_Id : Array_Id;
+ Current_Array : Array_Data;
+ Element_Id : Array_Element_Id;
+ Element : Array_Element;
+ List : String_List_Id;
+
+ begin
+ -- Process the associated array attributes of package Clean
+
+ Current_Array_Id := Arrays;
+ while Current_Array_Id /= No_Array loop
+ Current_Array := Shared.Arrays.Table (Current_Array_Id);
+
+ Element_Id := Current_Array.Value;
+ while Element_Id /= No_Array_Element loop
+ Element := Shared.Array_Elements.Table (Element_Id);
+
+ -- Get the name of the language
+
+ Lang_Index :=
+ Get_Language_From_Name
+ (Project, Get_Name_String (Element.Index));
+
+ if Lang_Index /= No_Language_Index then
+ case Current_Array.Name is
+
+ -- Attribute Object_Artifact_Extensions (<language>)
+
+ when Name_Object_Artifact_Extensions =>
+ List := Element.Value.Values;
+
+ if List /= Nil_String then
+ Put (Into_List =>
+ Lang_Index.Config.Clean_Object_Artifacts,
+ From_List => List,
+ In_Tree => Data.Tree);
+ end if;
+
+ -- Attribute Source_Artifact_Extensions (<language>)
+
+ when Name_Source_Artifact_Extensions =>
+ List := Element.Value.Values;
+
+ if List /= Nil_String then
+ Put (Into_List =>
+ Lang_Index.Config.Clean_Source_Artifacts,
+ From_List => List,
+ In_Tree => Data.Tree);
+ end if;
+
+ when others =>
+ null;
+ end case;
+ end if;
+
+ Element_Id := Element.Next;
+ end loop;
+
+ Current_Array_Id := Current_Array.Next;
+ end loop;
+ end Process_Clean;
+
----------------------
-- Process_Compiler --
----------------------
From_List => Element.Value.Values,
In_Tree => Data.Tree);
+ when Name_Object_Path_Switches =>
+ Put (Into_List =>
+ Lang_Index.Config.Object_Path_Switches,
+ From_List => Element.Value.Values,
+ In_Tree => Data.Tree);
+
-- Attribute Compiler_Pic_Option (<language>)
when Name_Pic_Option =>
Lang_Index := Get_Language_From_Name
(Project, Get_Name_String (Element.Index));
- if Lang_Index /= No_Language_Index then
+ if Lang_Index /= No_Language_Index
+ and then Element.Value.Kind = Single
+ and then Element.Value.Value /= No_Name
+ then
case Current_Array.Name is
when Name_Spec_Suffix | Name_Specification_Suffix =>
Process_Builder (Element.Decl.Attributes);
+ when Name_Clean =>
+
+ -- Process attributes of package Clean
+
+ Process_Clean (Element.Decl.Attributes);
+ Process_Clean (Element.Decl.Arrays);
+
when Name_Compiler =>
-- Process attributes of package Compiler
Attribute.Value.Location, Project);
end;
+ elsif
+ Attribute.Name = Name_Library_Encapsulated_Supported
+ then
+ declare
+ pragma Unsuppress (All_Checks);
+ begin
+ Project.Config.Lib_Encapsulated_Supported :=
+ Boolean'Value (Get_Name_String (Attribute.Value.Value));
+ exception
+ when Constraint_Error =>
+ Error_Msg
+ (Data.Flags,
+ "invalid value """
+ & Get_Name_String (Attribute.Value.Value)
+ & """ for Library_Encapsulated_Supported",
+ Attribute.Value.Location, Project);
+ end;
+
elsif Attribute.Name = Name_Shared_Library_Prefix then
Project.Config.Shared_Lib_Prefix :=
File_Name_Type (Attribute.Value.Value);
Lang_Index.Config.Toolchain_Version :=
Element.Value.Value;
- -- For Ada, set proper checksum computation mode
+ -- For Ada, set proper checksum computation mode,
+ -- which has changed from version to version.
if Lang_Index.Name = Name_Ada then
declare
then
Checksum_GNAT_5_03 := True;
- -- Version 5.02 or earlier
+ -- Version 5.02 or earlier (no checksums)
if Vers (6) /= '5'
or else Vers (Vers'Last) < '3'
if Data.Flags.Compiler_Driver_Mandatory
and then Lang_Index.Config.Compiler_Driver = No_File
+ and then not Project.Externally_Built
then
Error_Msg_Name_1 := Lang_Index.Display_Name;
Error_Msg
(Data.Flags,
- "?no compiler specified for language %%" &
+ "?\no compiler specified for language %%" &
", ignoring all its sources",
No_Location, Project);
if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File then
Error_Msg
(Data.Flags,
- "Spec_Suffix not specified for " &
+ "\Spec_Suffix not specified for " &
Get_Name_String (Lang_Index.Name),
No_Location, Project);
end if;
if Lang_Index.Config.Naming_Data.Body_Suffix = No_File then
Error_Msg
(Data.Flags,
- "Body_Suffix not specified for " &
+ "\Body_Suffix not specified for " &
Get_Name_String (Lang_Index.Name),
No_Location, Project);
end if;
Error_Msg_Name_1 := Lang_Index.Display_Name;
Error_Msg
(Data.Flags,
- "no suffixes specified for %%",
+ "\no suffixes specified for %%",
No_Location, Project);
end if;
end if;
Project.Decl.Attributes,
Shared);
- List : String_List_Id;
- Element : String_Element;
- Name : File_Name_Type;
- Iter : Source_Iterator;
- Source : Source_Id;
- Project_2 : Project_Id;
- Other : Source_Id;
+ List : String_List_Id;
+ Element : String_Element;
+ Name : File_Name_Type;
+ Iter : Source_Iterator;
+ Source : Source_Id;
+ Project_2 : Project_Id;
+ Other : Source_Id;
+ Unit_Found : Boolean;
+
+ Interface_ALIs : String_List_Id := Nil_String;
+ Other_Interfaces : String_List_Id := Nil_String;
begin
if not Interfaces.Default then
Name := Canonical_Case_File_Name (Element.Value);
Project_2 := Project;
- Big_Loop :
- while Project_2 /= No_Project loop
- Iter := For_Each_Source (Data.Tree, Project_2);
+ Big_Loop : while Project_2 /= No_Project loop
+ if Project.Qualifier = Aggregate_Library then
+
+ -- For an aggregate library we want to consider sources of
+ -- all aggregated projects.
+
+ Iter := For_Each_Source (Data.Tree);
+
+ else
+ Iter := For_Each_Source (Data.Tree, Project_2);
+ end if;
loop
Source := Prj.Element (Iter);
Other.Declared_In_Interfaces := True;
end if;
+ -- Unit based case
+
+ if Source.Language.Config.Kind = Unit_Based then
+ if Source.Kind = Spec
+ and then Other_Part (Source) /= No_Source
+ then
+ Source := Other_Part (Source);
+ end if;
+
+ String_Element_Table.Increment_Last
+ (Shared.String_Elements);
+
+ Shared.String_Elements.Table
+ (String_Element_Table.Last
+ (Shared.String_Elements)) :=
+ (Value => Name_Id (Source.Dep_Name),
+ Index => 0,
+ Display_Value => Name_Id (Source.Dep_Name),
+ Location => No_Location,
+ Flag => False,
+ Next => Interface_ALIs);
+
+ Interface_ALIs :=
+ String_Element_Table.Last
+ (Shared.String_Elements);
+
+ -- File based case
+
+ else
+ String_Element_Table.Increment_Last
+ (Shared.String_Elements);
+
+ Shared.String_Elements.Table
+ (String_Element_Table.Last
+ (Shared.String_Elements)) :=
+ (Value => Name_Id (Source.File),
+ Index => 0,
+ Display_Value => Name_Id (Source.Display_File),
+ Location => No_Location,
+ Flag => False,
+ Next => Other_Interfaces);
+
+ Other_Interfaces :=
+ String_Element_Table.Last
+ (Shared.String_Elements);
+ end if;
+
Debug_Output
("interface: ", Name_Id (Source.Path.Name));
end if;
end loop;
Project.Interfaces_Defined := True;
+ Project.Lib_Interface_ALIs := Interface_ALIs;
+ Project.Other_Interfaces := Other_Interfaces;
elsif Project.Library and then not Library_Interface.Default then
Get_Name_String (Element.Value);
To_Lower (Name_Buffer (1 .. Name_Len));
Name := Name_Find;
+ Unit_Found := False;
Project_2 := Project;
- Big_Loop_2 :
- while Project_2 /= No_Project loop
- Iter := For_Each_Source (Data.Tree, Project_2);
+ Big_Loop_2 : while Project_2 /= No_Project loop
+ if Project.Qualifier = Aggregate_Library then
+
+ -- For an aggregate library we want to consider sources of
+ -- all aggregated projects.
+
+ Iter := For_Each_Source (Data.Tree);
+
+ else
+ Iter := For_Each_Source (Data.Tree, Project_2);
+ end if;
loop
Source := Prj.Element (Iter);
exit when Source = No_Source;
- if Source.Unit /= No_Unit_Index and then
- Source.Unit.Name = Name_Id (Name)
+ if Source.Unit /= No_Unit_Index
+ and then Source.Unit.Name = Name_Id (Name)
then
if not Source.Locally_Removed then
Source.In_Interfaces := True;
Source.Declared_In_Interfaces := True;
+ Project.Interfaces_Defined := True;
Other := Other_Part (Source);
Debug_Output
("interface: ", Name_Id (Source.Path.Name));
+
+ if Source.Kind = Spec
+ and then Other_Part (Source) /= No_Source
+ then
+ Source := Other_Part (Source);
+ end if;
+
+ String_Element_Table.Increment_Last
+ (Shared.String_Elements);
+
+ Shared.String_Elements.Table
+ (String_Element_Table.Last
+ (Shared.String_Elements)) :=
+ (Value => Name_Id (Source.Dep_Name),
+ Index => 0,
+ Display_Value => Name_Id (Source.Dep_Name),
+ Location => No_Location,
+ Flag => False,
+ Next => Interface_ALIs);
+
+ Interface_ALIs :=
+ String_Element_Table.Last (Shared.String_Elements);
end if;
+ Unit_Found := True;
exit Big_Loop_2;
end if;
Project_2 := Project_2.Extends;
end loop Big_Loop_2;
+ if not Unit_Found then
+ Error_Msg_Name_1 := Name_Id (Name);
+
+ Error_Msg
+ (Data.Flags,
+ "%% is not a unit of this project",
+ Element.Location, Project);
+ end if;
+
List := Element.Next;
end loop;
- Project.Interfaces_Defined := True;
+ Project.Lib_Interface_ALIs := Interface_ALIs;
elsif Project.Extends /= No_Project
and then Project.Extends.Interfaces_Defined
Next (Iter);
end loop;
+
+ Project.Lib_Interface_ALIs := Project.Extends.Lib_Interface_ALIs;
end if;
end Check_Interfaces;
is
Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
- Attributes : constant Prj.Variable_Id := Project.Decl.Attributes;
+ Attributes : constant Prj.Variable_Id := Project.Decl.Attributes;
- Lib_Dir : constant Prj.Variable_Value :=
- Prj.Util.Value_Of
- (Snames.Name_Library_Dir, Attributes, Shared);
+ Lib_Dir : constant Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Library_Dir, Attributes, Shared);
- Lib_Name : constant Prj.Variable_Value :=
- Prj.Util.Value_Of
- (Snames.Name_Library_Name, Attributes, Shared);
+ Lib_Name : constant Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Library_Name, Attributes, Shared);
- Lib_Version : constant Prj.Variable_Value :=
- Prj.Util.Value_Of
- (Snames.Name_Library_Version, Attributes, Shared);
+ Lib_Standalone : constant Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Library_Standalone,
+ Attributes, Shared);
- Lib_ALI_Dir : constant Prj.Variable_Value :=
- Prj.Util.Value_Of
- (Snames.Name_Library_Ali_Dir, Attributes, Shared);
+ Lib_Version : constant Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Library_Version, Attributes, Shared);
- Lib_GCC : constant Prj.Variable_Value :=
- Prj.Util.Value_Of
- (Snames.Name_Library_GCC, Attributes, Shared);
+ Lib_ALI_Dir : constant Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Library_Ali_Dir, Attributes, Shared);
- The_Lib_Kind : constant Prj.Variable_Value :=
- Prj.Util.Value_Of
- (Snames.Name_Library_Kind, Attributes, Shared);
+ Lib_GCC : constant Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Library_GCC, Attributes, Shared);
- Imported_Project_List : Project_List;
-
- Continuation : String_Access := No_Continuation_String'Access;
+ The_Lib_Kind : constant Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Library_Kind, Attributes, Shared);
+ Imported_Project_List : Project_List;
+ Continuation : String_Access := No_Continuation_String'Access;
Support_For_Libraries : Library_Support;
Library_Directory_Present : Boolean;
procedure Check_Library (Proj : Project_Id; Extends : Boolean);
-- Check if an imported or extended project if also a library project
+ procedure Check_Aggregate_Library_Dirs;
+ -- Check that the library directory and the library ALI directory of an
+ -- aggregate library project are not the same as the object directory or
+ -- the library directory of any of its aggregated projects.
+
+ ----------------------------------
+ -- Check_Aggregate_Library_Dirs --
+ ----------------------------------
+
+ procedure Check_Aggregate_Library_Dirs is
+ procedure Process_Aggregate (Proj : Project_Id);
+ -- Recursive procedure to check the aggregated projects, as they may
+ -- also be aggregated library projects.
+
+ -----------------------
+ -- Process_Aggregate --
+ -----------------------
+
+ procedure Process_Aggregate (Proj : Project_Id) is
+ Agg : Aggregated_Project_List;
+
+ begin
+ Agg := Proj.Aggregated_Projects;
+ while Agg /= null loop
+ Error_Msg_Name_1 := Agg.Project.Name;
+
+ if Agg.Project.Qualifier /= Aggregate_Library
+ and then Project.Library_ALI_Dir.Name =
+ Agg.Project.Object_Directory.Name
+ then
+ Error_Msg
+ (Data.Flags,
+ "aggregate library 'A'L'I directory cannot be shared with"
+ & " object directory of aggregated project %%",
+ The_Lib_Kind.Location, Project);
+
+ elsif Project.Library_ALI_Dir.Name =
+ Agg.Project.Library_Dir.Name
+ then
+ Error_Msg
+ (Data.Flags,
+ "aggregate library 'A'L'I directory cannot be shared with"
+ & " library directory of aggregated project %%",
+ The_Lib_Kind.Location, Project);
+
+ elsif Agg.Project.Qualifier /= Aggregate_Library
+ and then Project.Library_Dir.Name =
+ Agg.Project.Object_Directory.Name
+ then
+ Error_Msg
+ (Data.Flags,
+ "aggregate library directory cannot be shared with"
+ & " object directory of aggregated project %%",
+ The_Lib_Kind.Location, Project);
+
+ elsif Project.Library_Dir.Name =
+ Agg.Project.Library_Dir.Name
+ then
+ Error_Msg
+ (Data.Flags,
+ "aggregate library directory cannot be shared with"
+ & " library directory of aggregated project %%",
+ The_Lib_Kind.Location, Project);
+ end if;
+
+ if Agg.Project.Qualifier = Aggregate_Library then
+ Process_Aggregate (Agg.Project);
+ end if;
+
+ Agg := Agg.Next;
+ end loop;
+ end Process_Aggregate;
+
+ -- Start of processing for Check_Aggregate_Library_Dirs
+
+ begin
+ if Project.Qualifier = Aggregate_Library then
+ Process_Aggregate (Project);
+ end if;
+ end Check_Aggregate_Library_Dirs;
+
-------------------
-- Check_Library --
-------------------
Continuation := Continuation_String'Access;
end if;
- elsif (not Unchecked_Shared_Lib_Imports)
- and then Project.Library_Kind /= Static
+ elsif not Unchecked_Shared_Lib_Imports
+ and then Project.Library_Kind /= Static
then
Error_Msg
(Data.Flags,
end if;
end if;
- elsif Project.Library_Kind /= Static and then
- Proj.Library_Kind = Static
+ elsif Project.Library_Kind /= Static
+ and then not Lib_Standalone.Default
+ and then Get_Name_String (Lib_Standalone.Value) = "encapsulated"
+ and then Proj.Library_Kind /= Static
+ then
+ -- An encapsulated library must depend only on static libraries
+
+ Error_Msg_Name_1 := Project.Name;
+ Error_Msg_Name_2 := Proj.Name;
+
+ Error_Msg
+ (Data.Flags,
+ Continuation.all &
+ "encapsulated library project %% cannot import shared " &
+ "library project %%",
+ Project.Location, Project);
+ Continuation := Continuation_String'Access;
+
+ elsif Project.Library_Kind /= Static
+ and then Proj.Library_Kind = Static
+ and then
+ (Lib_Standalone.Default
+ or else
+ Get_Name_String (Lib_Standalone.Value) /= "encapsulated")
then
Error_Msg_Name_1 := Project.Name;
Error_Msg_Name_2 := Proj.Name;
end if;
if not Dir_Exists then
+ if Directories_Must_Exist_In_Projects then
- -- Get the absolute name of the library directory that
- -- does not exist, to report an error.
+ -- Get the absolute name of the library directory that does
+ -- not exist, to report an error.
- Err_Vars.Error_Msg_File_1 :=
- File_Name_Type (Project.Library_Dir.Display_Name);
- Error_Msg
- (Data.Flags,
- "library directory { does not exist",
- Lib_Dir.Location, Project);
+ Err_Vars.Error_Msg_File_1 :=
+ File_Name_Type (Project.Library_Dir.Display_Name);
+ Error_Msg
+ (Data.Flags,
+ "library directory { does not exist",
+ Lib_Dir.Location, Project);
+ end if;
+
+ -- Checks for object/source directories
+
+ elsif not Project.Externally_Built
- elsif not Project.Externally_Built then
+ -- An aggregate library does not have sources or objects, so
+ -- these tests are not required in this case.
+ and then Project.Qualifier /= Aggregate_Library
+ then
-- Library directory cannot be the same as Object directory
if Project.Library_Dir.Name = Project.Object_Directory.Name then
File_Name_Type (Dir_Elem.Value);
Error_Msg
(Data.Flags,
- "library directory cannot be the same " &
- "as source directory {",
+ "library directory cannot be the same "
+ & "as source directory {",
Lib_Dir.Location, Project);
OK := False;
exit;
Error_Msg
(Data.Flags,
- "library directory cannot be the same" &
- " as source directory { of project %%",
+ "library directory cannot be the same "
+ & "as source directory { of project %%",
Lib_Dir.Location, Project);
OK := False;
exit Project_Loop;
Project.Library :=
Project.Library_Dir /= No_Path_Information
- and then Project.Library_Name /= No_Name;
+ and then Project.Library_Name /= No_Name;
if Project.Extends = No_Project then
case Project.Qualifier is
Lib_Name.Location, Project);
end if;
- when Library =>
+ when Library | Aggregate_Library =>
if not Project.Library then
if Project.Library_Name = No_Name then
Error_Msg
when others =>
null;
-
end case;
end if;
if Project.Library then
Support_For_Libraries := Project.Config.Lib_Support;
- if Support_For_Libraries = Prj.None then
+ if not Project.Externally_Built
+ and then Support_For_Libraries = Prj.None
+ then
Error_Msg
(Data.Flags,
"?libraries are not supported on this platform",
Lib_ALI_Dir.Location, Project);
end if;
- if (not Project.Externally_Built) and then
- Project.Library_ALI_Dir /= Project.Library_Dir
+ if not Project.Externally_Built
+ and then Project.Library_ALI_Dir /= Project.Library_Dir
then
-- The library ALI directory cannot be the same as the
-- Object directory.
end if;
if Project.Library_Kind /= Static then
- if Support_For_Libraries = Prj.Static_Only then
+ if not Project.Externally_Built
+ and then Support_For_Libraries = Prj.Static_Only
+ then
Error_Msg
(Data.Flags,
"only static libraries are supported " &
end;
end if;
- if Project.Library then
+ if Project.Library
+ and then Project.Qualifier /= Aggregate_Library
+ then
Debug_Output ("this is a library project file");
Check_Library (Project.Extends, Extends => True);
Imported_Project_List := Imported_Project_List.Next;
end loop;
end if;
-
end if;
end if;
if Switches /= No_Array_Element then
Error_Msg
(Data.Flags,
- "?Linker switches not taken into account in library " &
+ "?\Linker switches not taken into account in library " &
"projects",
No_Location, Project);
end if;
-- Check if the same library name is used in an other library project
for J in 1 .. Lib_Data_Table.Last loop
- if Lib_Data_Table.Table (J).Name = Project.Library_Name then
+ if Lib_Data_Table.Table (J).Name = Project.Library_Name
+ and then Lib_Data_Table.Table (J).Tree = Data.Tree
+ then
Error_Msg_Name_1 := Lib_Data_Table.Table (J).Proj.Name;
Error_Msg
(Data.Flags,
end loop;
end if;
- if Project.Library then
+ if not Lib_Standalone.Default
+ and then Project.Library_Kind = Static
+ then
+ -- An standalone library must be a shared library
+
+ Error_Msg_Name_1 := Project.Name;
+
+ Error_Msg
+ (Data.Flags,
+ Continuation.all &
+ "standalone library project %% must be a shared library",
+ Project.Location, Project);
+ Continuation := Continuation_String'Access;
+ end if;
+
+ -- Check that aggregated libraries do not share the aggregate
+ -- Library_ALI_Dir.
+
+ if Project.Qualifier = Aggregate_Library then
+ Check_Aggregate_Library_Dirs;
+ end if;
+
+ if Project.Library and not Data.In_Aggregate_Lib then
-- Record the library name
Lib_Data_Table.Append
- ((Name => Project.Library_Name, Proj => Project));
+ ((Name => Project.Library_Name,
+ Proj => Project,
+ Tree => Data.Tree));
end if;
end Check_Library_Attributes;
Shared => Shared);
end if;
- if Suffix /= Nil_Variable_Value then
+ if Suffix /= Nil_Variable_Value
+ and then Suffix.Value /= No_Name
+ then
Lang_Id.Config.Naming_Data.Spec_Suffix :=
File_Name_Type (Suffix.Value);
Shared => Shared);
end if;
- if Suffix /= Nil_Variable_Value then
+ if Suffix /= Nil_Variable_Value
+ and then Suffix.Value /= No_Name
+ then
Lang_Id.Config.Naming_Data.Body_Suffix :=
File_Name_Type (Suffix.Value);
Lang_Id := Lang_Id.Next;
end loop;
- -- Get the naming exceptions for all languages
+ -- Get the naming exceptions for all languages, but not for virtual
+ -- projects.
- for Kind in Spec_Or_Body loop
- Lang_Id := Project.Languages;
- while Lang_Id /= No_Language_Index loop
- case Lang_Id.Config.Kind is
+ if not Project.Virtual then
+ for Kind in Spec_Or_Body loop
+ Lang_Id := Project.Languages;
+ while Lang_Id /= No_Language_Index loop
+ case Lang_Id.Config.Kind is
when File_Based =>
Process_Exceptions_File_Based (Lang_Id, Kind);
when Unit_Based =>
Process_Exceptions_Unit_Based (Lang_Id, Kind);
- end case;
+ end case;
- Lang_Id := Lang_Id.Next;
+ Lang_Id := Lang_Id.Next;
+ end loop;
end loop;
- end loop;
+ end if;
end Check_Naming;
----------------------------
is
Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
- Lib_Interfaces : constant Prj.Variable_Value :=
+ Lib_Name : constant Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Library_Name,
+ Project.Decl.Attributes,
+ Shared);
+
+ Lib_Standalone : constant Prj.Variable_Value :=
Prj.Util.Value_Of
- (Snames.Name_Library_Interface,
+ (Snames.Name_Library_Standalone,
Project.Decl.Attributes,
Shared);
Auto_Init_Supported : Boolean;
OK : Boolean := True;
- Source : Source_Id;
- Next_Proj : Project_Id;
- Iter : Source_Iterator;
begin
Auto_Init_Supported := Project.Config.Auto_Init_Supported;
- pragma Assert (Lib_Interfaces.Kind = List);
-
- -- It is a stand-alone library project file if attribute
- -- Library_Interface is defined.
-
- if not Lib_Interfaces.Default then
- declare
- Interfaces : String_List_Id := Lib_Interfaces.Values;
- Interface_ALIs : String_List_Id := Nil_String;
- Unit : Name_Id;
-
- begin
- Project.Standalone_Library := True;
-
- -- Library_Interface cannot be an empty list
-
- if Interfaces = Nil_String then
- Error_Msg
- (Data.Flags,
- "Library_Interface cannot be an empty list",
- Lib_Interfaces.Location, Project);
- end if;
-
- -- Process each unit name specified in the attribute
- -- Library_Interface.
+ -- It is a stand-alone library project file if there is at least one
+ -- unit in the declared or inherited interface.
- while Interfaces /= Nil_String loop
- Get_Name_String
- (Shared.String_Elements.Table (Interfaces).Value);
- To_Lower (Name_Buffer (1 .. Name_Len));
+ if Project.Lib_Interface_ALIs = Nil_String then
+ if not Lib_Standalone.Default
+ and then Get_Name_String (Lib_Standalone.Value) /= "no"
+ then
+ Error_Msg
+ (Data.Flags,
+ "Library_Standalone valid only if library has Ada interfaces",
+ Lib_Standalone.Location, Project);
+ end if;
- if Name_Len = 0 then
- Error_Msg
- (Data.Flags,
- "an interface cannot be an empty string",
- Shared.String_Elements.Table (Interfaces).Location,
- Project);
+ else
+ if Project.Standalone_Library = No then
+ Project.Standalone_Library := Standard;
+ end if;
- else
- Unit := Name_Find;
- Error_Msg_Name_1 := Unit;
+ -- The name of a stand-alone library needs to have the syntax of an
+ -- Ada identifier.
- Next_Proj := Project.Extends;
- Iter := For_Each_Source (Data.Tree, Project);
- loop
- while Prj.Element (Iter) /= No_Source
- and then
- (Prj.Element (Iter).Unit = null
- or else Prj.Element (Iter).Unit.Name /= Unit)
- loop
- Next (Iter);
- end loop;
+ declare
+ Name : constant String := Get_Name_String (Project.Library_Name);
+ OK : Boolean := Is_Letter (Name (Name'First));
- Source := Prj.Element (Iter);
- exit when Source /= No_Source
- or else Next_Proj = No_Project;
+ Underline : Boolean := False;
- Iter := For_Each_Source (Data.Tree, Next_Proj);
- Next_Proj := Next_Proj.Extends;
- end loop;
+ begin
+ for J in Name'First + 1 .. Name'Last loop
+ exit when not OK;
- if Source /= No_Source then
- if Source.Kind = Sep then
- Source := No_Source;
+ if Is_Alphanumeric (Name (J)) then
+ Underline := False;
- elsif Source.Kind = Spec
- and then Other_Part (Source) /= No_Source
- then
- Source := Other_Part (Source);
- end if;
+ elsif Name (J) = '_' then
+ if Underline then
+ OK := False;
+ else
+ Underline := True;
end if;
- if Source /= No_Source then
- if Source.Project /= Project
- and then not Is_Extending (Project, Source.Project)
- then
- Source := No_Source;
- end if;
- end if;
+ else
+ OK := False;
+ end if;
+ end loop;
- if Source = No_Source then
- Error_Msg
- (Data.Flags,
- "%% is not a unit of this project",
- Shared.String_Elements.Table (Interfaces).Location,
- Project);
+ OK := OK and not Underline;
- else
- if Source.Kind = Spec
- and then Other_Part (Source) /= No_Source
- then
- Source := Other_Part (Source);
- end if;
+ if not OK then
+ Error_Msg
+ (Data.Flags,
+ "Incorrect library name for a Stand-Alone Library",
+ Lib_Name.Location, Project);
+ return;
+ end if;
+ end;
- String_Element_Table.Increment_Last
- (Shared.String_Elements);
-
- Shared.String_Elements.Table
- (String_Element_Table.Last (Shared.String_Elements)) :=
- (Value => Name_Id (Source.Dep_Name),
- Index => 0,
- Display_Value => Name_Id (Source.Dep_Name),
- Location =>
- Shared.String_Elements.Table (Interfaces).Location,
- Flag => False,
- Next => Interface_ALIs);
-
- Interface_ALIs :=
- String_Element_Table.Last (Shared.String_Elements);
- end if;
- end if;
+ if Lib_Standalone.Default then
+ Project.Standalone_Library := Standard;
- Interfaces := Shared.String_Elements.Table (Interfaces).Next;
- end loop;
+ else
+ Get_Name_String (Lib_Standalone.Value);
+ To_Lower (Name_Buffer (1 .. Name_Len));
- -- Put the list of Interface ALIs in the project data
+ if Name_Buffer (1 .. Name_Len) = "standard" then
+ Project.Standalone_Library := Standard;
- Project.Lib_Interface_ALIs := Interface_ALIs;
+ elsif Name_Buffer (1 .. Name_Len) = "encapsulated" then
+ Project.Standalone_Library := Encapsulated;
- -- Check value of attribute Library_Auto_Init and set
- -- Lib_Auto_Init accordingly.
+ elsif Name_Buffer (1 .. Name_Len) = "no" then
+ Project.Standalone_Library := No;
+ Error_Msg
+ (Data.Flags,
+ "wrong value for Library_Standalone "
+ & "when Library_Interface defined",
+ Lib_Standalone.Location, Project);
- if Lib_Auto_Init.Default then
+ else
+ Error_Msg
+ (Data.Flags,
+ "invalid value for attribute Library_Standalone",
+ Lib_Standalone.Location, Project);
+ end if;
+ end if;
- -- If no attribute Library_Auto_Init is declared, then set auto
- -- init only if it is supported.
+ -- Check value of attribute Library_Auto_Init and set Lib_Auto_Init
+ -- accordingly.
- Project.Lib_Auto_Init := Auto_Init_Supported;
+ if Lib_Auto_Init.Default then
- else
- Get_Name_String (Lib_Auto_Init.Value);
- To_Lower (Name_Buffer (1 .. Name_Len));
+ -- If no attribute Library_Auto_Init is declared, then set auto
+ -- init only if it is supported.
- if Name_Buffer (1 .. Name_Len) = "false" then
- Project.Lib_Auto_Init := False;
+ Project.Lib_Auto_Init := Auto_Init_Supported;
- elsif Name_Buffer (1 .. Name_Len) = "true" then
- if Auto_Init_Supported then
- Project.Lib_Auto_Init := True;
+ else
+ Get_Name_String (Lib_Auto_Init.Value);
+ To_Lower (Name_Buffer (1 .. Name_Len));
- else
- -- Library_Auto_Init cannot be "true" if auto init is not
- -- supported.
+ if Name_Buffer (1 .. Name_Len) = "false" then
+ Project.Lib_Auto_Init := False;
- Error_Msg
- (Data.Flags,
- "library auto init not supported " &
- "on this platform",
- Lib_Auto_Init.Location, Project);
- end if;
+ elsif Name_Buffer (1 .. Name_Len) = "true" then
+ if Auto_Init_Supported then
+ Project.Lib_Auto_Init := True;
else
+ -- Library_Auto_Init cannot be "true" if auto init is not
+ -- supported.
+
Error_Msg
(Data.Flags,
- "invalid value for attribute Library_Auto_Init",
+ "library auto init not supported " &
+ "on this platform",
Lib_Auto_Init.Location, Project);
end if;
+
+ else
+ Error_Msg
+ (Data.Flags,
+ "invalid value for attribute Library_Auto_Init",
+ Lib_Auto_Init.Location, Project);
end if;
- end;
+ end if;
-- If attribute Library_Src_Dir is defined and not the empty string,
-- check if the directory exist and is not the object directory or
(Get_Name_String (Lib_Symbol_Policy.Value));
begin
- -- Symbol policy must hove one of a limited number of values
+ -- Symbol policy must have one of a limited number of values
if Value = "autonomous" or else Value = "default" then
Project.Symbol_Data.Symbol_Policy := Autonomous;
if OK then
for J in 1 .. Name_Len loop
- if Name_Buffer (J) = '/'
- or else Name_Buffer (J) = Directory_Separator
- then
+ if Is_Directory_Separator (Name_Buffer (J)) then
OK := False;
exit;
end if;
Error_Msg_Warn :=
Project.Symbol_Data.Symbol_Policy /= Controlled
- and then Project.Symbol_Data.Symbol_Policy /= Direct;
+ and then Project.Symbol_Data.Symbol_Policy /= Direct;
Error_Msg
(Data.Flags,
function Is_Reserved (Name : Name_Id) return Boolean is
begin
if Get_Name_Table_Byte (Name) /= 0
- and then Name /= Name_Project
- and then Name /= Name_Extends
- and then Name /= Name_External
+ and then
+ not Nam_In (Name, Name_Project, Name_Extends, Name_External)
and then Name not in Ada_2005_Reserved_Words
then
Unit := No_Name;
Name_Len := The_Name'Length;
Name_Buffer (1 .. Name_Len) := The_Name;
- -- Special cases of children of packages A, G, I and S on VMS
-
- if OpenVMS_On_Target
- and then Name_Len > 3
- and then Name_Buffer (2 .. 3) = "__"
- and then
- ((Name_Buffer (1) = 'a') or else
- (Name_Buffer (1) = 'g') or else
- (Name_Buffer (1) = 'i') or else
- (Name_Buffer (1) = 's'))
- then
- Name_Buffer (2) := '.';
- Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len);
- Name_Len := Name_Len - 1;
- end if;
-
Real_Name := Name_Find;
if Is_Reserved (Real_Name) then
OK := OK and then not Need_Letter and then not Last_Underscore;
if OK then
- if First /= Name'First and then
- Is_Reserved (The_Name (First .. The_Name'Last))
+ if First /= Name'First
+ and then Is_Reserved (The_Name (First .. The_Name'Last))
then
return;
end if;
function Compute_Directory_Last (Dir : String) return Natural is
begin
if Dir'Length > 1
- and then (Dir (Dir'Last - 1) = Directory_Separator
- or else
- Dir (Dir'Last - 1) = '/')
+ and then Is_Directory_Separator (Dir (Dir'Last - 1))
then
return Dir'Last - 1;
else
Dir_Exists : Boolean;
No_Sources : constant Boolean :=
- ((not Source_Files.Default
- and then Source_Files.Values = Nil_String)
- or else
- (not Source_Dirs.Default
- and then Source_Dirs.Values = Nil_String)
- or else
- (not Languages.Default
- and then Languages.Values = Nil_String))
- and then Project.Extends = No_Project;
+ Project.Qualifier = Abstract_Project
+ or else (((not Source_Files.Default
+ and then Source_Files.Values = Nil_String)
+ or else
+ (not Source_Dirs.Default
+ and then Source_Dirs.Values = Nil_String)
+ or else
+ (not Languages.Default
+ and then Languages.Values = Nil_String))
+ and then Project.Extends = No_Project);
-- Start of processing for Get_Directories
"Object_Dir cannot be empty",
Object_Dir.Location, Project);
- elsif not No_Sources then
+ elsif Setup_Projects
+ and then No_Sources
+ and then Project.Extends = No_Project
+ then
+ -- Do not create an object directory for a non extending project
+ -- with no sources.
+
+ Locate_Directory
+ (Project,
+ File_Name_Type (Object_Dir.Value),
+ Path => Project.Object_Directory,
+ Dir_Exists => Dir_Exists,
+ Data => Data,
+ Location => Object_Dir.Location,
+ Must_Exist => False,
+ Externally_Built => Project.Externally_Built);
+ else
-- We check that the specified object directory does exist.
-- However, even when it doesn't exist, we set it to a default
-- value. This is for the benefit of tools that recover from
Externally_Built => Project.Externally_Built);
if not Dir_Exists and then not Project.Externally_Built then
- -- The object directory does not exist, report an error if the
- -- project is not externally built.
+ if Opt.Directories_Must_Exist_In_Projects then
- Err_Vars.Error_Msg_File_1 :=
- File_Name_Type (Object_Dir.Value);
- Error_Or_Warning
- (Data.Flags, Data.Flags.Require_Obj_Dirs,
- "object directory { not found", Project.Location, Project);
+ -- The object directory does not exist, report an error if
+ -- the project is not externally built.
+
+ Err_Vars.Error_Msg_File_1 :=
+ File_Name_Type (Object_Dir.Value);
+ Error_Or_Warning
+ (Data.Flags, Data.Flags.Require_Obj_Dirs,
+ "object directory { not found",
+ Project.Location, Project);
+ end if;
end if;
end if;
- elsif not No_Sources and then Subdirs /= null then
+ elsif not No_Sources
+ and then (Subdirs /= null or else Build_Tree_Dir /= null)
+ then
Name_Len := 1;
Name_Buffer (1) := '.';
Locate_Directory
"Exec_Dir cannot be empty",
Exec_Dir.Location, Project);
- elsif not No_Sources then
+ elsif Setup_Projects
+ and then No_Sources
+ and then Project.Extends = No_Project
+ then
+ -- Do not create an exec directory for a non extending project
+ -- with no sources.
+
+ Locate_Directory
+ (Project,
+ File_Name_Type (Exec_Dir.Value),
+ Path => Project.Exec_Directory,
+ Dir_Exists => Dir_Exists,
+ Data => Data,
+ Location => Exec_Dir.Location,
+ Externally_Built => Project.Externally_Built);
+ else
-- We check that the specified exec directory does exist
Locate_Directory
Externally_Built => Project.Externally_Built);
if not Dir_Exists then
- Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
- Error_Or_Warning
- (Data.Flags, Data.Flags.Missing_Source_Files,
- "exec directory { not found", Project.Location, Project);
+ if Opt.Directories_Must_Exist_In_Projects then
+ Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
+ Error_Or_Warning
+ (Data.Flags, Data.Flags.Missing_Source_Files,
+ "exec directory { not found", Project.Location, Project);
+
+ else
+ Project.Exec_Directory := No_Path_Information;
+ end if;
end if;
end if;
end if;
pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
- if not Source_Files.Default
- and then Source_Files.Values = Nil_String
+ if not Source_Files.Default and then Source_Files.Values = Nil_String
then
Project.Source_Dirs := Nil_String;
-- A non empty, non comment line should contain a file name
- if Last /= 0
- and then (Last = 1 or else Line (1 .. 2) /= "--")
- then
+ if Last /= 0 and then (Last = 1 or else Line (1 .. 2) /= "--") then
Name_Len := Last;
Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
-- Check that there is no directory information
for J in 1 .. Last loop
- if Line (J) = '/' or else Line (J) = Directory_Separator then
+ if Is_Directory_Separator (Line (J)) then
Error_Msg_File_1 := Source_Name;
Error_Msg
(Data.Flags,
Naming : Lang_Naming_Data;
Kind : out Source_Kind;
Unit : out Name_Id;
- Project : Project_Processing_Data;
- In_Tree : Project_Tree_Ref)
+ Project : Project_Processing_Data)
is
Filename : constant String := Get_Name_String (File_Name);
Last : Integer := Filename'Last;
-- In the standard GNAT naming scheme, check for special cases: children
-- or separates of A, G, I or S, and run time sources.
- if Is_Standard_GNAT_Naming (Naming)
- and then Name_Len >= 3
- then
+ if Is_Standard_GNAT_Naming (Naming) and then Name_Len >= 3 then
declare
S1 : constant Character := Name_Buffer (1);
S2 : constant Character := Name_Buffer (2);
S3 : constant Character := Name_Buffer (3);
begin
- if S1 = 'a'
- or else S1 = 'g'
- or else S1 = 'i'
- or else S1 = 's'
- then
+ if S1 = 'a' or else S1 = 'g' or else S1 = 'i' or else S1 = 's' then
+
-- Children or separates of packages A, G, I or S. These names
-- are x__ ... or x~... (where x is a, g, i, or s). Both
-- versions (x__... and x~...) are allowed in all platforms,
end if;
end if;
- if Unit /= No_Name
- and then Current_Verbosity = High
- then
+ if Unit /= No_Name and then Current_Verbosity = High then
case Kind is
when Spec => Debug_Output ("spec of", Unit);
when Impl => Debug_Output ("body of", Unit);
The_Name : File_Name_Type;
begin
- Get_Name_String (Name);
+ -- Check if we have a root-object dir specified, if so relocate all
+ -- artefact directories to it.
+
+ if Build_Tree_Dir /= null
+ and then Create /= ""
+ and then not Is_Absolute_Path (Get_Name_String (Name))
+ then
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer (Build_Tree_Dir.all);
+
+ if The_Parent_Last - The_Parent'First + 1 < Root_Dir'Length then
+ Err_Vars.Error_Msg_File_1 := Name;
+ Error_Or_Warning
+ (Data.Flags, Error,
+ "{ cannot relocate deeper than " & Create & " directory",
+ No_Location, Project);
+ end if;
+
+ Add_Str_To_Name_Buffer
+ (Relative_Path
+ (The_Parent (The_Parent'First .. The_Parent_Last),
+ Root_Dir.all));
+ Add_Str_To_Name_Buffer (Get_Name_String (Name));
+
+ else
+ if Build_Tree_Dir /= null and then Create /= "" then
+
+ -- Issue a warning that we cannot relocate absolute obj dir
+
+ Err_Vars.Error_Msg_File_1 := Name;
+ Error_Or_Warning
+ (Data.Flags, Warning,
+ "{ cannot relocate absolute object directory",
+ No_Location, Project);
+ end if;
+
+ Get_Name_String (Name);
+ end if;
-- Add Subdirs.all if it is a directory that may be created and
-- Subdirs is not null;
exception
when Use_Error =>
+
+ -- Output message with name of directory. Note that we
+ -- use the ~ insertion method here in case the name
+ -- has special characters in it.
+
+ Error_Msg_Strlen := Full_Path_Name'Length;
+ Error_Msg_String (1 .. Error_Msg_Strlen) :=
+ Full_Path_Name.all;
Error_Msg
(Data.Flags,
- "could not create " & Create &
- " directory " & Full_Path_Name.all,
- Location, Project);
+ "could not create " & Create & " directory ~",
+ Location,
+ Project);
end;
end if;
end if;
Dir_Exists := Is_Directory (Full_Path_Name.all);
- if not Must_Exist or else Dir_Exists then
+ if not Must_Exist or Dir_Exists then
declare
Normed : constant String :=
Normalize_Pathname
-- Check that there is no directory information
for J in 1 .. Last loop
- if Line (J) = '/'
- or else Line (J) = Directory_Separator
- then
+ if Is_Directory_Separator (Line (J)) then
Error_Msg_File_1 := Name;
Error_Msg
(Data.Flags,
- "file name cannot include " &
- "directory information ({)",
+ "file name cannot include "
+ & "directory information ({)",
Location, Project.Project);
exit;
end if;
-- need for an object directory, if not specified.
if Project.Project.Extends = No_Project
- and then Project.Project.Object_Directory =
- Project.Project.Directory
+ and then
+ Project.Project.Object_Directory = Project.Project.Directory
+ and then not (Project.Project.Qualifier = Aggregate_Library)
then
Project.Project.Object_Directory := No_Path_Information;
end if;
-- Check that there is no directory information
for J in 1 .. Name_Len loop
- if Name_Buffer (J) = '/'
- or else Name_Buffer (J) = Directory_Separator
- then
+ if Is_Directory_Separator (Name_Buffer (J)) then
Error_Msg_File_1 := Name;
Error_Msg
(Data.Flags,
(Project.Source_Names, Source.File);
if NL /= No_Name_Location and then not NL.Listed then
+
-- Remove the exception
+
Source_Names_Htable.Set
(Project.Source_Names,
Source.File,
Error_Msg_Name_2 := Source.Unit.Name;
Error_Or_Warning
(Data.Flags, Data.Flags.Missing_Source_Files,
- "source file %% for unit %% not found",
+ "\source file %% for unit %% not found",
No_Location, Project.Project);
end if;
end if;
procedure Free (Data : in out Project_Processing_Data) is
begin
- Source_Names_Htable.Reset (Data.Source_Names);
- Unit_Exceptions_Htable.Reset (Data.Unit_Exceptions);
- Excluded_Sources_Htable.Reset (Data.Excluded);
+ Source_Names_Htable.Reset (Data.Source_Names);
+ Unit_Exceptions_Htable.Reset (Data.Unit_Exceptions);
+ Excluded_Sources_Htable.Reset (Data.Excluded);
end Free;
-------------------------------
-------------------------------
procedure Check_File_Naming_Schemes
- (In_Tree : Project_Tree_Ref;
- Project : Project_Processing_Data;
+ (Project : Project_Processing_Data;
File_Name : File_Name_Type;
Alternate_Languages : out Language_List;
Language : out Language_Ptr;
if not Header_File then
Compute_Unit_Name
- (File_Name => File_Name,
- Naming => Config.Naming_Data,
- Kind => Kind,
- Unit => Unit,
- Project => Project,
- In_Tree => In_Tree);
+ (File_Name => File_Name,
+ Naming => Config.Naming_Data,
+ Kind => Kind,
+ Unit => Unit,
+ Project => Project);
if Unit /= No_Name then
Language := Tmp_Lang;
Source.Kind := Kind;
- if Current_Verbosity = High
- and then Source.File /= No_File
- then
+ if Current_Verbosity = High and then Source.File /= No_File then
Debug_Output ("override kind for "
& Get_Name_String (Source.File)
& " idx=" & Source.Index'Img
& " kind=" & Source.Kind'Img);
end if;
- if Source.Kind in Spec_Or_Body and then Source.Unit /= null then
- Source.Unit.File_Names (Source.Kind) := Source;
+ if Source.Unit /= null then
+ if Source.Kind = Spec then
+ Source.Unit.File_Names (Spec) := Source;
+ else
+ Source.Unit.File_Names (Impl) := Source;
+ end if;
end if;
end Override_Kind;
-- Check if it is OK to have the same file name in several
-- source directories.
- if Source_Dir_Rank = Name_Loc.Source.Source_Dir_Rank then
+ if Name_Loc.Source /= No_Source
+ and then Source_Dir_Rank = Name_Loc.Source.Source_Dir_Rank
+ then
Error_Msg_File_1 := File_Name;
Error_Msg
(Data.Flags,
if Name_Loc.Source.Naming_Exception = Inherited then
declare
- Proj : Project_Id := Name_Loc.Source.Project.Extends;
- Iter : Source_Iterator;
- Src : Source_Id;
+ Proj : Project_Id := Name_Loc.Source.Project.Extends;
+ Iter : Source_Iterator;
+ Src : Source_Id;
begin
while Proj /= No_Project loop
Iter := For_Each_Source (Data.Tree, Proj);
Name_Loc.Source.Unit.Name,
Name_Loc.Source.Unit);
end if;
-
end if;
end if;
end if;
if Check_Name then
Check_File_Naming_Schemes
- (In_Tree => Data.Tree,
- Project => Project,
+ (Project => Project,
File_Name => File_Name,
Alternate_Languages => Alternate_Languages,
Language => Language,
-- A file name in a list must be a source of a language
- if Data.Flags.Error_On_Unknown_Language
- and then Name_Loc.Found
+ if Data.Flags.Error_On_Unknown_Language and then Name_Loc.Found
then
Error_Msg_File_1 := File_Name;
Error_Msg
(Path : Path_Information;
Rank : Natural) return Boolean
is
- Dir : Dir_Type;
- Name : String (1 .. 250);
- Last : Natural;
- Found : Path_Information;
+ Dir : Dir_Type;
+ Name : String (1 .. 250);
+ Last : Natural;
+ Found : Path_Information;
Success : Boolean := False;
begin
Rank : Natural) return Boolean
is
Path_Str : constant String := Get_Name_String (Path.Display_Name);
- Dir : Dir_Type;
- Name : String (1 .. 250);
- Last : Natural;
- Success : Boolean := False;
+ Dir : Dir_Type;
+ Name : String (1 .. 250);
+ Last : Natural;
+ Success : Boolean := False;
begin
Debug_Output ("looking for subdirs of ", Name_Id (Path.Display_Name));
Read (Dir, Name, Last);
exit when Last = 0;
- if Name (1 .. Last) /= "."
- and then Name (1 .. Last) /= ".."
- then
+ if Name (1 .. Last) /= "." and then Name (1 .. Last) /= ".." then
declare
Path_Name : constant String :=
- Normalize_Pathname
- (Name => Name (1 .. Last),
- Directory => Path_Str,
- Resolve_Links => Resolve_Links)
- & Directory_Separator;
- Path2 : Path_Information;
- OK : Boolean := True;
+ Normalize_Pathname
+ (Name => Name (1 .. Last),
+ Directory => Path_Str,
+ Resolve_Links => Resolve_Links)
+ & Directory_Separator;
+
+ Path2 : Path_Information;
+ OK : Boolean := True;
begin
if Is_Directory (Path_Name) then
if Search_For = Search_Files then
while Pattern_End >= Pattern'First
- and then Pattern (Pattern_End) /= '/'
- and then Pattern (Pattern_End) /= Directory_Separator
+ and then not Is_Directory_Separator (Pattern (Pattern_End))
loop
Pattern_End := Pattern_End - 1;
end loop;
Recursive :=
Pattern_End - 1 >= Pattern'First
and then Pattern (Pattern_End - 1 .. Pattern_End) = "**"
- and then (Pattern_End - 1 = Pattern'First
- or else Pattern (Pattern_End - 2) = '/'
- or else Pattern (Pattern_End - 2) = Directory_Separator);
+ and then
+ (Pattern_End - 1 = Pattern'First
+ or else Is_Directory_Separator (Pattern (Pattern_End - 2)));
if Recursive then
Pattern_End := Pattern_End - 2;
end if;
if not Has_Error then
+
-- Links have been resolved if necessary, and Path_Name
-- always ends with a directory separator.
-- Loop through subdirectories
- Source_Dir := Project.Project.Source_Dirs;
Src_Dir_Rank := Project.Project.Source_Dir_Ranks;
+ Source_Dir := Project.Project.Source_Dirs;
while Source_Dir /= Nil_String loop
begin
Num_Nod := Shared.Number_Lists.Table (Src_Dir_Rank);
declare
Source_Directory : constant String :=
Get_Name_String (Element.Value)
- & Directory_Separator;
+ & Directory_Separator;
Dir_Last : constant Natural :=
Compute_Directory_Last (Source_Directory);
loop
Read (Dir, Name, Last);
-
exit when Last = 0;
-- In fast project loading mode (without -eL), the user
if not Opt.Follow_Links_For_Files
or else Is_Regular_File
- (Display_Source_Directory & Name (1 .. Last))
+ (Display_Source_Directory & Name (1 .. Last))
then
Name_Len := Last;
Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
Error_Msg_File_1 := Source.File;
Error_Msg
(Data.Flags,
- "{ cannot be both excluded and an exception file name",
+ "\{ cannot be both excluded and an exception file name",
No_Location, Project.Project);
end if;
Continuation : Boolean := False;
Iter : Source_Iterator;
begin
- if not Project.Project.Externally_Built
- and then not Extending
- then
+ if not Project.Project.Externally_Built and then not Extending then
Language := Project.Project.Languages;
while Language /= No_Language_Index loop
if Language.First_Source = No_Source
and then (Data.Flags.Require_Sources_Other_Lang
- or else Language.Name = Name_Ada)
+ or else Language.Name = Name_Ada)
then
Iter := For_Each_Source (In_Tree => Data.Tree,
Project => Project.Project);
if Source /= No_Source
and then Source.Replaced_By = No_Source
and then Source.Path /= Src.Path
+ and then Source.Index = 0
+ and then Src.Index = 0
and then Is_Extending (Src.Project, Source.Project)
then
Error_Msg_File_1 := Src.File;
Error_Msg_File_2 := Source.File;
Error_Msg
(Data.Flags,
- "{ and { have the same object file name",
+ "\{ and { have the same object file name",
No_Location, Project.Project);
else
(Project.Excluded, Source.File);
if Excluded /= No_File_Found then
- Source.Locally_Removed := True;
Source.In_Interfaces := False;
+ Source.Locally_Removed := True;
+
+ if Proj = Project.Project then
+ Source.Suppressed := True;
+ end if;
if Current_Verbosity = High then
Debug_Indent;
-- unit name is not null.
if Src.Kind /= Sep and then Src.Unit_Name /= No_Name then
-
declare
UData : Unit_Index :=
- Units_Htable.Get
- (Data.Tree.Units_HT, Src.Unit_Name);
+ Units_Htable.Get (Data.Tree.Units_HT, Src.Unit_Name);
begin
if UData = No_Unit_Index then
UData := new Unit_Data;
when Warning | Error =>
declare
Msg : constant String :=
- "<there are no "
- & Lang_Name & " sources in this project";
+ "<there are no "
+ & Lang_Name & " sources in this project";
begin
Error_Msg_Warn := Data.Flags.When_No_Sources = Warning;
Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Flags : Processing_Flags)
is
+
+ procedure Check
+ (Project : Project_Id;
+ In_Aggregate_Lib : Boolean;
+ Data : in out Tree_Processing_Data);
+ -- Process the naming scheme for a single project
+
procedure Recursive_Check
(Project : Project_Id;
Prj_Tree : Project_Tree_Ref;
+ Context : Project_Context;
Data : in out Tree_Processing_Data);
-- Check_Naming_Scheme for the project
+ -----------
+ -- Check --
+ -----------
+
+ procedure Check
+ (Project : Project_Id;
+ In_Aggregate_Lib : Boolean;
+ Data : in out Tree_Processing_Data)
+ is
+ procedure Check_Aggregated;
+ -- Check aggregated projects which should not be externally built
+
+ ----------------------
+ -- Check_Aggregated --
+ ----------------------
+
+ procedure Check_Aggregated is
+ L : Aggregated_Project_List;
+
+ begin
+ -- Check that aggregated projects are not externally built
+
+ L := Project.Aggregated_Projects;
+ while L /= null loop
+ declare
+ Var : constant Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Externally_Built,
+ L.Project.Decl.Attributes,
+ Data.Tree.Shared);
+ begin
+ if not Var.Default then
+ Error_Msg_Name_1 := L.Project.Display_Name;
+ Error_Msg
+ (Data.Flags,
+ "cannot aggregate externally built project %%",
+ Var.Location, Project);
+ end if;
+ end;
+
+ L := L.Next;
+ end loop;
+ end Check_Aggregated;
+
+ -- Local Variables
+
+ Shared : constant Shared_Project_Tree_Data_Access :=
+ Data.Tree.Shared;
+ Prj_Data : Project_Processing_Data;
+
+ -- Start of processing for Check
+
+ begin
+ Debug_Increase_Indent ("check", Project.Name);
+
+ Initialize (Prj_Data, Project);
+
+ Check_If_Externally_Built (Project, Data);
+
+ case Project.Qualifier is
+ when Aggregate =>
+ Check_Aggregated;
+
+ when Aggregate_Library =>
+ Check_Aggregated;
+
+ if Project.Object_Directory = No_Path_Information then
+ Project.Object_Directory := Project.Directory;
+ end if;
+
+ when others =>
+ Get_Directories (Project, Data);
+ Check_Programming_Languages (Project, Data);
+
+ if Current_Verbosity = High then
+ Show_Source_Dirs (Project, Shared);
+ end if;
+
+ if Project.Qualifier = Abstract_Project then
+ Check_Abstract_Project (Project, Data);
+ end if;
+ end case;
+
+ -- Check configuration. Must be done for gnatmake (even though no
+ -- user configuration file was provided) since the default config we
+ -- generate indicates whether libraries are supported for instance.
+
+ Check_Configuration (Project, Data);
+
+ if Project.Qualifier /= Aggregate then
+ Check_Library_Attributes (Project, Data);
+ Check_Package_Naming (Project, Data);
+
+ -- An aggregate library has no source, no need to look for them
+
+ if Project.Qualifier /= Aggregate_Library then
+ Look_For_Sources (Prj_Data, Data);
+ end if;
+
+ Check_Interfaces (Project, Data);
+
+ -- If this library is part of an aggregated library don't check it
+ -- as it has no sources by itself and so interface won't be found.
+
+ if Project.Library and not In_Aggregate_Lib then
+ Check_Stand_Alone_Library (Project, Data);
+ end if;
+
+ Get_Mains (Project, Data);
+ end if;
+
+ Free (Prj_Data);
+
+ Debug_Decrease_Indent ("done check");
+ end Check;
+
---------------------
-- Recursive_Check --
---------------------
procedure Recursive_Check
(Project : Project_Id;
Prj_Tree : Project_Tree_Ref;
- Data : in out Tree_Processing_Data) is
+ Context : Project_Context;
+ Data : in out Tree_Processing_Data)
+ is
begin
if Current_Verbosity = High then
Debug_Increase_Indent
end if;
Data.Tree := Prj_Tree;
- Prj.Nmsc.Check (Project, Data);
+ Data.In_Aggregate_Lib := Context.In_Aggregate_Lib;
+
+ Check (Project, Context.In_Aggregate_Lib, Data);
if Current_Verbosity = High then
Debug_Decrease_Indent ("done Processing_Naming_Scheme");
end if;
end Recursive_Check;
- procedure Check_All_Projects is new
- For_Every_Project_Imported (Tree_Processing_Data, Recursive_Check);
+ procedure Check_All_Projects is new For_Every_Project_Imported_Context
+ (Tree_Processing_Data, Recursive_Check);
+ -- Comment required???
+
+ -- Local Variables
Data : Tree_Processing_Data;
-- Start of processing for Process_Naming_Scheme
+
begin
Lib_Data_Table.Init;
Initialize (Data, Tree => Tree, Node_Tree => Node_Tree, Flags => Flags);
List := Tree.Projects;
while List /= null loop
Proj := List.Project;
+
Exte := Proj;
while Exte.Extended_By /= No_Project loop
Exte := Exte.Extended_By;
projects / thirdparty / gcc.git / blobdiff