-- --
-- 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.Directories;
with Ada.Strings; use Ada.Strings;
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);
generic
with procedure Callback
- (Path : Path_Information;
- Pattern_Index : Natural);
+ (Path : Path_Information;
+ Pattern_Index : Natural);
procedure Expand_Subdirectory_Pattern
(Project : Project_Id;
Data : in out Tree_Processing_Data;
Kind : Source_Kind;
File_Name : File_Name_Type;
Display_File : File_Name_Type;
- Naming_Exception : Boolean := False;
- Path : Path_Information := No_Path_Information;
- Alternate_Languages : Language_List := null;
- Unit : Name_Id := No_Name;
- Index : Int := 0;
- Locally_Removed : Boolean := False;
- Location : Source_Ptr := No_Location);
+ Naming_Exception : Naming_Exception_Type := No;
+ Path : Path_Information := No_Path_Information;
+ Alternate_Languages : Language_List := null;
+ Unit : Name_Id := No_Name;
+ Index : Int := 0;
+ Locally_Removed : Boolean := False;
+ Location : Source_Ptr := No_Location);
-- Add a new source to the different lists: list of all sources in the
-- project tree, list of source of a project and list of sources of a
-- language. If Path is specified, the file is also added to
-- Copy Str into Name_Buffer, replacing Pattern with Replacement. Str is
-- converted to lower-case at the same time.
- procedure Check_Ada_Name (Name : String; Unit : out Name_Id);
- -- Check that a name is a valid Ada unit name
-
- procedure Check_Package_Naming
+ procedure Check_Abstract_Project
(Project : Project_Id;
Data : in out Tree_Processing_Data);
- -- Check the naming scheme part of Data, and initialize the naming scheme
- -- data in the config of the various languages.
+ -- Check abstract projects attributes
procedure Check_Configuration
(Project : Project_Id;
-- Check the library attributes of project Project in project tree
-- and modify its data Data accordingly.
- procedure Check_Abstract_Project
+ procedure Check_Package_Naming
(Project : Project_Id;
Data : in out Tree_Processing_Data);
- -- Check abstract projects attributes
+ -- Check the naming scheme part of Data, and initialize the naming scheme
+ -- data in the config of the various languages.
procedure Check_Programming_Languages
(Project : Project_Id;
-- Check if project Project in project tree Data.Tree is a Stand-Alone
-- Library project, and modify its data Data accordingly if it is one.
+ procedure Check_Unit_Name (Name : String; Unit : out Name_Id);
+ -- Check that a name is a valid unit name
+
function Compute_Directory_Last (Dir : String) return Natural;
-- Return the index of the last significant character in Dir. This is used
-- to avoid duplicate '/' (slash) characters at the end of directory names.
-- 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;
-- the same value.
procedure Get_Directories
- (Project : Project_Id;
- Data : in out Tree_Processing_Data);
+ (Project : Project_Id;
+ Data : in out Tree_Processing_Data);
-- Get the object directory, the exec directory and the source directories
-- of a project.
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)
+ -- should not match a file with the same name).
if Suf (Suf'First) = '.' then
Min_Prefix_Length := 1;
end if;
return Filename'Length >= Suf'Length + Min_Prefix_Length
- and then Filename
- (Filename'Last - Suf'Length + 1 .. Filename'Last) = Suf;
+ and then
+ Filename (Filename'Last - Suf'Length + 1 .. Filename'Last) = Suf;
end;
end Suffix_Matches;
Kind : Source_Kind;
File_Name : File_Name_Type;
Display_File : File_Name_Type;
- Naming_Exception : Boolean := False;
- Path : Path_Information := No_Path_Information;
- Alternate_Languages : Language_List := null;
- Unit : Name_Id := No_Name;
- Index : Int := 0;
- Locally_Removed : Boolean := False;
- Location : Source_Ptr := No_Location)
+ Naming_Exception : Naming_Exception_Type := No;
+ Path : Path_Information := No_Path_Information;
+ Alternate_Languages : Language_List := null;
+ Unit : Name_Id := No_Name;
+ Index : Int := 0;
+ Locally_Removed : Boolean := False;
+ Location : Source_Ptr := No_Location)
is
- Config : constant Language_Config := Lang_Id.Config;
- UData : Unit_Index;
- Add_Src : Boolean;
- Source : Source_Id;
- Prev_Unit : Unit_Index := No_Unit_Index;
+ Config : constant Language_Config := Lang_Id.Config;
+ UData : Unit_Index;
+ Add_Src : Boolean;
+ Source : Source_Id;
+ Prev_Unit : Unit_Index := No_Unit_Index;
Source_To_Replace : Source_Id := No_Source;
begin
Source := Source_Files_Htable.Get
(Data.Tree.Source_Files_HT, File_Name);
- if Source /= No_Source
- and then Source.Index = Index
- then
+ if Source /= No_Source and then Source.Index = Index then
Add_Src := False;
end if;
end if;
- -- Duplication of file/unit in same project is allowed if order of
- -- source directories is known.
+ -- 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 Source_Dir_Rank /= Source.Source_Dir_Rank then
- Add_Src := False;
+ 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.
- else
- Error_Msg_File_1 := File_Name;
- Error_Msg
- (Data.Flags, "duplicate source file name {",
- Location, Project);
- Add_Src := False;
- end if;
+ if Add_Src = False then
+ Add_Src := True;
- else
- if Source_Dir_Rank /= Source.Source_Dir_Rank then
- Add_Src := False;
+ if Project = Source.Project then
+ if Prev_Unit = No_Unit_Index then
+ if Data.Flags.Allow_Duplicate_Basenames then
+ Add_Src := True;
- -- We might be seeing the same file through a different path
- -- (for instance because of symbolic links).
+ elsif Lang_Id.Config.Compiler_Driver = Empty_File then
+ Add_Src := True;
- elsif Source.Path.Name /= Path.Name then
- if not Source.Duplicate_Unit then
- Error_Msg_Name_1 := Unit;
+ elsif Source_Dir_Rank /= Source.Source_Dir_Rank then
+ Add_Src := False;
+
+ 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 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;
if Current_Verbosity = High then
Debug_Indent;
- Write_Str ("Adding source File: ");
+ Write_Str ("adding source File: ");
Write_Str (Get_Name_String (Display_File));
if Index /= 0 then
if UData = No_Unit_Index then
UData := new Unit_Data;
UData.Name := Unit;
- Units_Htable.Set (Data.Tree.Units_HT, Unit, UData);
+
+ if Naming_Exception /= Inherited then
+ Units_Htable.Set (Data.Tree.Units_HT, Unit, UData);
+ end if;
end if;
Id.Unit := UData;
-- Note that this updates Unit information as well
- Override_Kind (Id, Kind);
+ if Naming_Exception /= Inherited and then not Locally_Removed then
+ Override_Kind (Id, Kind);
+ end if;
end if;
if Path /= No_Path_Information then
Remove_Source (Data.Tree, Source_To_Replace, Id);
end if;
- if Data.Tree.Replaced_Source_Number > 0 and then
- Replaced_Source_HTable.Get (Data.Tree.Replaced_Sources, Id.File) /=
- No_File
+ if Data.Tree.Replaced_Source_Number > 0
+ and then
+ Replaced_Source_HTable.Get
+ (Data.Tree.Replaced_Sources, Id.File) /= No_File
then
Replaced_Source_HTable.Remove (Data.Tree.Replaced_Sources, Id.File);
Data.Tree.Replaced_Source_Number :=
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
begin
if Path.Name /= Project.Path.Name then
- Debug_Output ("Aggregates: ", Name_Id (Path.Display_Name));
+ Debug_Output ("aggregates: ", Name_Id (Path.Display_Name));
-- For usual "with" statement, this phase will have been done when
-- parsing the project itself. However, for aggregate projects, we
Add_Aggregated_Project (Project, Path => Path.Name);
else
- Debug_Output ("Pattern returned the aggregate itself, ignored");
+ Debug_Output ("pattern returned the aggregate itself, ignored");
end if;
end Found_Project_File;
-- 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;
end if;
end Check_Abstract_Project;
- -----------
- -- Check --
- -----------
+ -------------------------
+ -- Check_Configuration --
+ -------------------------
- procedure Check
+ procedure Check_Configuration
(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);
+ Shared : constant Shared_Project_Tree_Data_Access :=
+ Data.Tree.Shared;
- Initialize (Prj_Data, Project);
+ Dot_Replacement : File_Name_Type := No_File;
+ Casing : Casing_Type := All_Lower_Case;
+ Separate_Suffix : File_Name_Type := No_File;
- Check_If_Externally_Built (Project, Data);
+ Lang_Index : Language_Ptr := No_Language_Index;
+ -- The index of the language data being checked
- if Project.Qualifier /= Aggregate then
- Get_Directories (Project, Data);
- Check_Programming_Languages (Project, Data);
+ Prev_Index : Language_Ptr := No_Language_Index;
+ -- The index of the previous language
- if Current_Verbosity = High then
- Show_Source_Dirs (Project, Shared);
- end if;
- end if;
+ procedure Process_Project_Level_Simple_Attributes;
+ -- Process the simple attributes at the project level
- case Project.Qualifier is
- when Dry => Check_Abstract_Project (Project, Data);
- when others => null;
- end case;
+ procedure Process_Project_Level_Array_Attributes;
+ -- Process the associate array attributes at the project level
- -- 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.
+ procedure Process_Packages;
+ -- Read the packages of the project
- Check_Configuration (Project, Data);
+ ----------------------
+ -- Process_Packages --
+ ----------------------
- 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);
+ procedure Process_Packages is
+ Packages : Package_Id;
+ Element : Package_Element;
- if Project.Library then
- Check_Stand_Alone_Library (Project, Data);
- end if;
+ procedure Process_Binder (Arrays : Array_Id);
+ -- Process the associated array attributes of package Binder
- Get_Mains (Project, Data);
- end if;
+ procedure Process_Builder (Attributes : Variable_Id);
+ -- Process the simple attributes of package Builder
- Free (Prj_Data);
+ procedure Process_Clean (Attributes : Variable_Id);
+ -- Process the simple attributes of package Clean
- Debug_Decrease_Indent ("Done Check");
- end Check;
+ procedure Process_Clean (Arrays : Array_Id);
+ -- Process the associated array attributes of package Clean
- --------------------
- -- Check_Ada_Name --
- --------------------
+ procedure Process_Compiler (Arrays : Array_Id);
+ -- Process the associated array attributes of package Compiler
- procedure Check_Ada_Name (Name : String; Unit : out Name_Id) is
- The_Name : String := Name;
- Real_Name : Name_Id;
- Need_Letter : Boolean := True;
- Last_Underscore : Boolean := False;
- OK : Boolean := The_Name'Length > 0;
- First : Positive;
+ procedure Process_Naming (Attributes : Variable_Id);
+ -- Process the simple attributes of package Naming
- function Is_Reserved (Name : Name_Id) return Boolean;
- function Is_Reserved (S : String) return Boolean;
- -- Check that the given name is not an Ada 95 reserved word. The reason
- -- for the Ada 95 here is that we do not want to exclude the case of an
- -- Ada 95 unit called Interface (for example). In Ada 2005, such a unit
- -- name would be rejected anyway by the compiler. That means there is no
- -- requirement that the project file parser reject this.
+ procedure Process_Naming (Arrays : Array_Id);
+ -- Process the associated array attributes of package Naming
- -----------------
- -- Is_Reserved --
- -----------------
+ procedure Process_Linker (Attributes : Variable_Id);
+ -- Process the simple attributes of package Linker of a
+ -- configuration project.
- function Is_Reserved (S : String) return Boolean is
- begin
- Name_Len := 0;
- Add_Str_To_Name_Buffer (S);
- return Is_Reserved (Name_Find);
- end Is_Reserved;
+ --------------------
+ -- Process_Binder --
+ --------------------
- -----------------
- -- Is_Reserved --
- -----------------
+ procedure Process_Binder (Arrays : Array_Id) is
+ Current_Array_Id : Array_Id;
+ Current_Array : Array_Data;
+ Element_Id : Array_Element_Id;
+ Element : Array_Element;
- 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 Name not in Ada_2005_Reserved_Words
- then
- Unit := No_Name;
- Debug_Output ("Ada reserved word: ", Name);
- return True;
+ begin
+ -- Process the associative array attribute of package Binder
- else
- return False;
- end if;
- end Is_Reserved;
+ Current_Array_Id := Arrays;
+ while Current_Array_Id /= No_Array loop
+ Current_Array := Shared.Arrays.Table (Current_Array_Id);
- -- Start of processing for Check_Ada_Name
+ Element_Id := Current_Array.Value;
+ while Element_Id /= No_Array_Element loop
+ Element := Shared.Array_Elements.Table (Element_Id);
- begin
- To_Lower (The_Name);
+ if Element.Index /= All_Other_Names then
- Name_Len := The_Name'Length;
- Name_Buffer (1 .. Name_Len) := The_Name;
+ -- Get the name of the language
- -- Special cases of children of packages A, G, I and S on VMS
+ Lang_Index :=
+ Get_Language_From_Name
+ (Project, Get_Name_String (Element.Index));
- 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;
+ if Lang_Index /= No_Language_Index then
+ case Current_Array.Name is
+ when Name_Driver =>
- Real_Name := Name_Find;
+ -- Attribute Driver (<language>)
- if Is_Reserved (Real_Name) then
- return;
- end if;
+ Lang_Index.Config.Binder_Driver :=
+ File_Name_Type (Element.Value.Value);
- First := The_Name'First;
+ when Name_Required_Switches =>
+ Put
+ (Into_List =>
+ Lang_Index.Config.Binder_Required_Switches,
+ From_List => Element.Value.Values,
+ In_Tree => Data.Tree);
- for Index in The_Name'Range loop
- if Need_Letter then
+ when Name_Prefix =>
- -- We need a letter (at the beginning, and following a dot),
- -- but we don't have one.
+ -- Attribute Prefix (<language>)
- if Is_Letter (The_Name (Index)) then
- Need_Letter := False;
+ Lang_Index.Config.Binder_Prefix :=
+ Element.Value.Value;
- else
- OK := False;
+ when Name_Objects_Path =>
- if Current_Verbosity = High then
- Debug_Indent;
- Write_Int (Types.Int (Index));
- Write_Str (": '");
- Write_Char (The_Name (Index));
- Write_Line ("' is not a letter.");
- end if;
+ -- Attribute Objects_Path (<language>)
- exit;
- end if;
+ Lang_Index.Config.Objects_Path :=
+ Element.Value.Value;
- elsif Last_Underscore
- and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
- then
- -- Two underscores are illegal, and a dot cannot follow
- -- an underscore.
+ when Name_Objects_Path_File =>
- OK := False;
+ -- Attribute Objects_Path (<language>)
- if Current_Verbosity = High then
- Debug_Indent;
- Write_Int (Types.Int (Index));
- Write_Str (": '");
- Write_Char (The_Name (Index));
- Write_Line ("' is illegal here.");
- end if;
+ Lang_Index.Config.Objects_Path_File :=
+ Element.Value.Value;
- exit;
+ when others =>
+ null;
+ end case;
+ end if;
+ end if;
- elsif The_Name (Index) = '.' then
-
- -- First, check if the name before the dot is not a reserved word
-
- if Is_Reserved (The_Name (First .. Index - 1)) then
- return;
- end if;
+ Element_Id := Element.Next;
+ end loop;
- First := Index + 1;
+ Current_Array_Id := Current_Array.Next;
+ end loop;
+ end Process_Binder;
- -- We need a letter after a dot
+ ---------------------
+ -- Process_Builder --
+ ---------------------
- Need_Letter := True;
+ procedure Process_Builder (Attributes : Variable_Id) is
+ Attribute_Id : Variable_Id;
+ Attribute : Variable;
- elsif The_Name (Index) = '_' then
- Last_Underscore := True;
+ begin
+ -- Process non associated array attribute from package Builder
- else
- -- We need an letter or a digit
+ Attribute_Id := Attributes;
+ while Attribute_Id /= No_Variable loop
+ Attribute := Shared.Variable_Elements.Table (Attribute_Id);
- Last_Underscore := False;
+ if not Attribute.Value.Default then
+ if Attribute.Name = Name_Executable_Suffix then
- if not Is_Alphanumeric (The_Name (Index)) then
- OK := False;
+ -- Attribute Executable_Suffix: the suffix of the
+ -- executables.
- if Current_Verbosity = High then
- Debug_Indent;
- Write_Int (Types.Int (Index));
- Write_Str (": '");
- Write_Char (The_Name (Index));
- Write_Line ("' is not alphanumeric.");
+ Project.Config.Executable_Suffix :=
+ Attribute.Value.Value;
+ end if;
end if;
- exit;
- end if;
- end if;
- end loop;
-
- -- Cannot end with an underscore or a dot
-
- 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))
- then
- return;
- end if;
-
- Unit := Real_Name;
-
- else
- -- Signal a problem with No_Name
-
- Unit := No_Name;
- end if;
- end Check_Ada_Name;
-
- -------------------------
- -- Check_Configuration --
- -------------------------
-
- procedure Check_Configuration
- (Project : Project_Id;
- Data : in out Tree_Processing_Data)
- is
- Shared : constant Shared_Project_Tree_Data_Access :=
- Data.Tree.Shared;
-
- Dot_Replacement : File_Name_Type := No_File;
- Casing : Casing_Type := All_Lower_Case;
- Separate_Suffix : File_Name_Type := No_File;
-
- Lang_Index : Language_Ptr := No_Language_Index;
- -- The index of the language data being checked
+ Attribute_Id := Attribute.Next;
+ end loop;
+ end Process_Builder;
- Prev_Index : Language_Ptr := No_Language_Index;
- -- The index of the previous language
+ -------------------
+ -- Process_Clean --
+ -------------------
- procedure Process_Project_Level_Simple_Attributes;
- -- Process the simple attributes at the project level
+ procedure Process_Clean (Attributes : Variable_Id) is
+ Attribute_Id : Variable_Id;
+ Attribute : Variable;
+ List : String_List_Id;
- procedure Process_Project_Level_Array_Attributes;
- -- Process the associate array attributes at the project level
+ begin
+ -- Process non associated array attributes from package Clean
- procedure Process_Packages;
- -- Read the packages of the project
+ Attribute_Id := Attributes;
+ while Attribute_Id /= No_Variable loop
+ Attribute := Shared.Variable_Elements.Table (Attribute_Id);
- ----------------------
- -- Process_Packages --
- ----------------------
+ if not Attribute.Value.Default then
+ if Attribute.Name = Name_Artifacts_In_Exec_Dir then
- procedure Process_Packages is
- Packages : Package_Id;
- Element : Package_Element;
+ -- Attribute Artifacts_In_Exec_Dir: the list of file
+ -- names to be cleaned in the exec dir of the main
+ -- project.
- procedure Process_Binder (Arrays : Array_Id);
- -- Process the associate array attributes of package Binder
+ List := Attribute.Value.Values;
- procedure Process_Builder (Attributes : Variable_Id);
- -- Process the simple attributes of package Builder
+ if List /= Nil_String then
+ Put (Into_List =>
+ Project.Config.Artifacts_In_Exec_Dir,
+ From_List => List,
+ In_Tree => Data.Tree);
+ end if;
- procedure Process_Compiler (Arrays : Array_Id);
- -- Process the associate array attributes of package Compiler
+ elsif Attribute.Name = Name_Artifacts_In_Object_Dir then
- procedure Process_Naming (Attributes : Variable_Id);
- -- Process the simple attributes of package Naming
+ -- Attribute Artifacts_In_Exec_Dir: the list of file
+ -- names to be cleaned in the object dir of every
+ -- project.
- procedure Process_Naming (Arrays : Array_Id);
- -- Process the associate array attributes of package Naming
+ List := Attribute.Value.Values;
- procedure Process_Linker (Attributes : Variable_Id);
- -- Process the simple attributes of package Linker of a
- -- configuration project.
+ 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;
- --------------------
- -- Process_Binder --
- --------------------
+ Attribute_Id := Attribute.Next;
+ end loop;
+ end Process_Clean;
- procedure Process_Binder (Arrays : Array_Id) is
+ 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 associative array attribute of package Binder
+ -- Process the associated array attributes of package Clean
Current_Array_Id := Arrays;
while Current_Array_Id /= No_Array loop
while Element_Id /= No_Array_Element loop
Element := Shared.Array_Elements.Table (Element_Id);
- if Element.Index /= All_Other_Names then
-
- -- 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
- when Name_Driver =>
-
- -- Attribute Driver (<language>)
-
- Lang_Index.Config.Binder_Driver :=
- File_Name_Type (Element.Value.Value);
-
- when Name_Required_Switches =>
- Put
- (Into_List =>
- Lang_Index.Config.Binder_Required_Switches,
- From_List => Element.Value.Values,
- In_Tree => Data.Tree);
-
- when Name_Prefix =>
+ -- Get the name of the language
- -- Attribute Prefix (<language>)
+ Lang_Index :=
+ Get_Language_From_Name
+ (Project, Get_Name_String (Element.Index));
- Lang_Index.Config.Binder_Prefix :=
- Element.Value.Value;
+ if Lang_Index /= No_Language_Index then
+ case Current_Array.Name is
- when Name_Objects_Path =>
+ -- Attribute Object_Artifact_Extensions (<language>)
- -- Attribute Objects_Path (<language>)
+ when Name_Object_Artifact_Extensions =>
+ List := Element.Value.Values;
- Lang_Index.Config.Objects_Path :=
- Element.Value.Value;
+ if List /= Nil_String then
+ Put (Into_List =>
+ Lang_Index.Config.Clean_Object_Artifacts,
+ From_List => List,
+ In_Tree => Data.Tree);
+ end if;
- when Name_Objects_Path_File =>
+ -- Attribute Source_Artifact_Extensions (<language>)
- -- Attribute Objects_Path (<language>)
+ when Name_Source_Artifact_Extensions =>
+ List := Element.Value.Values;
- Lang_Index.Config.Objects_Path_File :=
- Element.Value.Value;
+ 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;
+ when others =>
+ null;
+ end case;
end if;
Element_Id := Element.Next;
Current_Array_Id := Current_Array.Next;
end loop;
- end Process_Binder;
-
- ---------------------
- -- Process_Builder --
- ---------------------
-
- procedure Process_Builder (Attributes : Variable_Id) is
- Attribute_Id : Variable_Id;
- Attribute : Variable;
-
- begin
- -- Process non associated array attribute from package Builder
-
- 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_Executable_Suffix then
-
- -- Attribute Executable_Suffix: the suffix of the
- -- executables.
-
- Project.Config.Executable_Suffix :=
- Attribute.Value.Value;
- end if;
- end if;
-
- Attribute_Id := Attribute.Next;
- end loop;
- end Process_Builder;
+ end Process_Clean;
----------------------
-- Process_Compiler --
if Lang_Index /= No_Language_Index then
case Current_Array.Name is
- when Name_Dependency_Switches =>
- -- Attribute Dependency_Switches (<language>)
+ -- Attribute Dependency_Kind (<language>)
+
+ when Name_Dependency_Kind =>
+ Get_Name_String (Element.Value.Value);
+
+ begin
+ Lang_Index.Config.Dependency_Kind :=
+ Dependency_File_Kind'Value
+ (Name_Buffer (1 .. Name_Len));
+
+ exception
+ when Constraint_Error =>
+ Error_Msg
+ (Data.Flags,
+ "illegal value for Dependency_Kind",
+ Element.Value.Location,
+ Project);
+ end;
+
+ -- Attribute Dependency_Switches (<language>)
+ when Name_Dependency_Switches =>
if Lang_Index.Config.Dependency_Kind = None then
Lang_Index.Config.Dependency_Kind := Makefile;
end if;
In_Tree => Data.Tree);
end if;
- when Name_Dependency_Driver =>
-
- -- Attribute Dependency_Driver (<language>)
+ -- Attribute Dependency_Driver (<language>)
+ when Name_Dependency_Driver =>
if Lang_Index.Config.Dependency_Kind = None then
Lang_Index.Config.Dependency_Kind := Makefile;
end if;
In_Tree => Data.Tree);
end if;
- when Name_Include_Switches =>
+ -- Attribute Language_Kind (<language>)
+
+ when Name_Language_Kind =>
+ Get_Name_String (Element.Value.Value);
+
+ begin
+ Lang_Index.Config.Kind :=
+ Language_Kind'Value
+ (Name_Buffer (1 .. Name_Len));
+
+ exception
+ when Constraint_Error =>
+ Error_Msg
+ (Data.Flags,
+ "illegal value for Language_Kind",
+ Element.Value.Location,
+ Project);
+ end;
- -- Attribute Include_Switches (<language>)
+ -- Attribute Include_Switches (<language>)
+ when Name_Include_Switches =>
List := Element.Value.Values;
if List = Nil_String then
From_List => List,
In_Tree => Data.Tree);
- when Name_Include_Path =>
-
- -- Attribute Include_Path (<language>)
+ -- Attribute Include_Path (<language>)
+ when Name_Include_Path =>
Lang_Index.Config.Include_Path :=
Element.Value.Value;
- when Name_Include_Path_File =>
-
- -- Attribute Include_Path_File (<language>)
+ -- Attribute Include_Path_File (<language>)
+ when Name_Include_Path_File =>
Lang_Index.Config.Include_Path_File :=
- Element.Value.Value;
-
- when Name_Driver =>
+ Element.Value.Value;
- -- Attribute Driver (<language>)
+ -- Attribute Driver (<language>)
+ when Name_Driver =>
Lang_Index.Config.Compiler_Driver :=
File_Name_Type (Element.Value.Value);
- when Name_Required_Switches |
- Name_Leading_Required_Switches =>
+ when Name_Required_Switches
+ | Name_Leading_Required_Switches
+ =>
Put (Into_List =>
Lang_Index.Config.
Compiler_Leading_Required_Switches,
Element.Value.Location, Project);
end;
+ when Name_Source_File_Switches =>
+ Put (Into_List =>
+ Lang_Index.Config.Source_File_Switches,
+ From_List => Element.Value.Values,
+ In_Tree => Data.Tree);
+
when Name_Object_File_Suffix =>
if Get_Name_String (Element.Value.Value) = "" then
Error_Msg
From_List => Element.Value.Values,
In_Tree => Data.Tree);
- when Name_Pic_Option =>
+ 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>)
+ -- Attribute Compiler_Pic_Option (<language>)
+ when Name_Pic_Option =>
List := Element.Value.Values;
if List = Nil_String then
From_List => List,
In_Tree => Data.Tree);
- when Name_Mapping_File_Switches =>
-
- -- Attribute Mapping_File_Switches (<language>)
+ -- Attribute Mapping_File_Switches (<language>)
+ when Name_Mapping_File_Switches =>
List := Element.Value.Values;
if List = Nil_String then
From_List => List,
In_Tree => Data.Tree);
- when Name_Mapping_Spec_Suffix =>
-
- -- Attribute Mapping_Spec_Suffix (<language>)
+ -- Attribute Mapping_Spec_Suffix (<language>)
+ when Name_Mapping_Spec_Suffix =>
Lang_Index.Config.Mapping_Spec_Suffix :=
File_Name_Type (Element.Value.Value);
- when Name_Mapping_Body_Suffix =>
-
- -- Attribute Mapping_Body_Suffix (<language>)
+ -- Attribute Mapping_Body_Suffix (<language>)
+ when Name_Mapping_Body_Suffix =>
Lang_Index.Config.Mapping_Body_Suffix :=
File_Name_Type (Element.Value.Value);
- when Name_Config_File_Switches =>
-
- -- Attribute Config_File_Switches (<language>)
+ -- Attribute Config_File_Switches (<language>)
+ when Name_Config_File_Switches =>
List := Element.Value.Values;
if List = Nil_String then
From_List => List,
In_Tree => Data.Tree);
- when Name_Objects_Path =>
-
- -- Attribute Objects_Path (<language>)
+ -- Attribute Objects_Path (<language>)
+ when Name_Objects_Path =>
Lang_Index.Config.Objects_Path :=
Element.Value.Value;
- when Name_Objects_Path_File =>
-
- -- Attribute Objects_Path_File (<language>)
+ -- Attribute Objects_Path_File (<language>)
+ when Name_Objects_Path_File =>
Lang_Index.Config.Objects_Path_File :=
Element.Value.Value;
- when Name_Config_Body_File_Name =>
-
- -- Attribute Config_Body_File_Name (<language>)
+ -- Attribute Config_Body_File_Name (<language>)
+ when Name_Config_Body_File_Name =>
Lang_Index.Config.Config_Body :=
Element.Value.Value;
- when Name_Config_Body_File_Name_Index =>
-
- -- Attribute Config_Body_File_Name_Index
- -- ( < Language > )
+ -- Attribute Config_Body_File_Name_Index (< Language>)
+ when Name_Config_Body_File_Name_Index =>
Lang_Index.Config.Config_Body_Index :=
Element.Value.Value;
- when Name_Config_Body_File_Name_Pattern =>
-
- -- Attribute Config_Body_File_Name_Pattern
- -- (<language>)
+ -- Attribute Config_Body_File_Name_Pattern(<language>)
+ when Name_Config_Body_File_Name_Pattern =>
Lang_Index.Config.Config_Body_Pattern :=
Element.Value.Value;
- when Name_Config_Spec_File_Name =>
-
-- Attribute Config_Spec_File_Name (<language>)
+ when Name_Config_Spec_File_Name =>
Lang_Index.Config.Config_Spec :=
Element.Value.Value;
- when Name_Config_Spec_File_Name_Index =>
-
- -- Attribute Config_Spec_File_Name_Index
- -- ( < Language > )
+ -- Attribute Config_Spec_File_Name_Index (<language>)
+ when Name_Config_Spec_File_Name_Index =>
Lang_Index.Config.Config_Spec_Index :=
Element.Value.Value;
- when Name_Config_Spec_File_Name_Pattern =>
-
- -- Attribute Config_Spec_File_Name_Pattern
- -- (<language>)
+ -- Attribute Config_Spec_File_Name_Pattern(<language>)
+ when Name_Config_Spec_File_Name_Pattern =>
Lang_Index.Config.Config_Spec_Pattern :=
Element.Value.Value;
- when Name_Config_File_Unique =>
-
- -- Attribute Config_File_Unique (<language>)
+ -- Attribute Config_File_Unique (<language>)
+ when Name_Config_File_Unique =>
begin
Lang_Index.Config.Config_File_Unique :=
Boolean'Value
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'
when Name_Runtime_Source_Dir =>
- -- Attribute Runtime_Library_Dir (<language>)
+ -- Attribute Runtime_Source_Dir (<language>)
Lang_Index.Config.Runtime_Source_Dir :=
Element.Value.Value;
Lang_Index := Project.Languages;
while Lang_Index /= No_Language_Index loop
- if Lang_Index.Name = Name_Ada then
+ if Lang_Index.Config.Kind = Unit_Based then
Lang_Index.Config.Naming_Data.Casing := Casing;
Lang_Index.Config.Naming_Data.Dot_Replacement := Dot_Replacement;
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);
Prev_Index.Next := Lang_Index.Next;
end if;
- elsif Lang_Index.Name = Name_Ada then
+ elsif Lang_Index.Config.Kind = Unit_Based then
Prev_Index := Lang_Index;
-- For unit based languages, Dot_Replacement, Spec_Suffix and
if Lang_Index.Config.Naming_Data.Dot_Replacement = No_File then
Error_Msg
(Data.Flags,
- "Dot_Replacement not specified for Ada",
+ "Dot_Replacement not specified for " &
+ Get_Name_String (Lang_Index.Name),
No_Location, Project);
end if;
if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File then
Error_Msg
(Data.Flags,
- "Spec_Suffix not specified for Ada",
+ "\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 Ada",
+ "\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;
end if;
if Project.Externally_Built then
- Debug_Output ("Project is externally built");
+ Debug_Output ("project is externally built");
else
- Debug_Output ("Project is not externally built");
+ Debug_Output ("project is not externally built");
end if;
end Check_If_Externally_Built;
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;
- --------------------------
- -- Check_Package_Naming --
- --------------------------
+ ------------------------------
+ -- Check_Library_Attributes --
+ ------------------------------
- procedure Check_Package_Naming
+ -- This procedure is awfully long (over 700 lines) should be broken up???
+
+ procedure Check_Library_Attributes
(Project : Project_Id;
Data : in out Tree_Processing_Data)
is
- Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
- Naming_Id : constant Package_Id :=
- Util.Value_Of
- (Name_Naming, Project.Decl.Packages, Shared);
- Naming : Package_Element;
+ Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
- Ada_Body_Suffix_Loc : Source_Ptr := No_Location;
+ Attributes : constant Prj.Variable_Id := Project.Decl.Attributes;
- procedure Check_Naming;
- -- Check the validity of the Naming package (suffixes valid, ...)
+ Lib_Dir : constant Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Library_Dir, Attributes, Shared);
- procedure Check_Common
- (Dot_Replacement : in out File_Name_Type;
- Casing : in out Casing_Type;
- Casing_Defined : out Boolean;
- Separate_Suffix : in out File_Name_Type;
- Sep_Suffix_Loc : out Source_Ptr);
- -- Check attributes common
+ Lib_Name : constant Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Library_Name, Attributes, Shared);
- procedure Process_Exceptions_File_Based
- (Lang_Id : Language_Ptr;
- Kind : Source_Kind);
- procedure Process_Exceptions_Unit_Based
- (Lang_Id : Language_Ptr;
- Kind : Source_Kind);
- -- Process the naming exceptions for the two types of languages
+ Lib_Standalone : constant Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Library_Standalone,
+ Attributes, Shared);
- procedure Initialize_Naming_Data;
- -- Initialize internal naming data for the various languages
+ Lib_Version : constant Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Library_Version, Attributes, Shared);
- ------------------
- -- Check_Common --
- ------------------
+ Lib_ALI_Dir : constant Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Library_Ali_Dir, Attributes, Shared);
- procedure Check_Common
- (Dot_Replacement : in out File_Name_Type;
- Casing : in out Casing_Type;
- Casing_Defined : out Boolean;
- Separate_Suffix : in out File_Name_Type;
- Sep_Suffix_Loc : out Source_Ptr)
- is
- Dot_Repl : constant Variable_Value :=
- Util.Value_Of
- (Name_Dot_Replacement,
- Naming.Decl.Attributes,
- Shared);
- Casing_String : constant Variable_Value :=
- Util.Value_Of
- (Name_Casing,
- Naming.Decl.Attributes,
- Shared);
- Sep_Suffix : constant Variable_Value :=
- Util.Value_Of
- (Name_Separate_Suffix,
- Naming.Decl.Attributes,
- Shared);
- Dot_Repl_Loc : Source_Ptr;
+ Lib_GCC : constant Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Library_GCC, Attributes, Shared);
- begin
- Sep_Suffix_Loc := No_Location;
+ The_Lib_Kind : constant Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Library_Kind, Attributes, Shared);
- if not Dot_Repl.Default then
- pragma Assert
- (Dot_Repl.Kind = Single, "Dot_Replacement is not a string");
+ Imported_Project_List : Project_List;
+ Continuation : String_Access := No_Continuation_String'Access;
+ Support_For_Libraries : Library_Support;
- if Length_Of_Name (Dot_Repl.Value) = 0 then
- Error_Msg
- (Data.Flags, "Dot_Replacement cannot be empty",
- Dot_Repl.Location, Project);
- end if;
+ Library_Directory_Present : Boolean;
- Dot_Replacement := Canonical_Case_File_Name (Dot_Repl.Value);
- Dot_Repl_Loc := Dot_Repl.Location;
+ procedure Check_Library (Proj : Project_Id; Extends : Boolean);
+ -- Check if an imported or extended project if also a library project
- declare
- Repl : constant String := Get_Name_String (Dot_Replacement);
+ 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.
- begin
- -- Dot_Replacement cannot
- -- - be empty
- -- - start or end with an alphanumeric
- -- - be a single '_'
- -- - start with an '_' followed by an alphanumeric
- -- - contain a '.' except if it is "."
+ ----------------------------------
+ -- Check_Aggregate_Library_Dirs --
+ ----------------------------------
- if Repl'Length = 0
- or else Is_Alphanumeric (Repl (Repl'First))
- or else Is_Alphanumeric (Repl (Repl'Last))
- or else (Repl (Repl'First) = '_'
- and then
- (Repl'Length = 1
- or else
- Is_Alphanumeric (Repl (Repl'First + 1))))
- or else (Repl'Length > 1
- and then
- Index (Source => Repl, Pattern => ".") /= 0)
- then
- Error_Msg
- (Data.Flags,
- '"' & Repl &
- """ is illegal for Dot_Replacement.",
- Dot_Repl_Loc, Project);
- end if;
- end;
- end if;
+ 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.
- if Dot_Replacement /= No_File then
- Write_Attr
- ("Dot_Replacement", Get_Name_String (Dot_Replacement));
- end if;
+ -----------------------
+ -- Process_Aggregate --
+ -----------------------
- Casing_Defined := False;
+ procedure Process_Aggregate (Proj : Project_Id) is
+ Agg : Aggregated_Project_List;
- if not Casing_String.Default then
- pragma Assert
- (Casing_String.Kind = Single, "Casing is not a string");
+ begin
+ Agg := Proj.Aggregated_Projects;
+ while Agg /= null loop
+ Error_Msg_Name_1 := Agg.Project.Name;
- declare
- Casing_Image : constant String :=
- Get_Name_String (Casing_String.Value);
+ 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);
- begin
- if Casing_Image'Length = 0 then
+ elsif Project.Library_ALI_Dir.Name =
+ Agg.Project.Library_Dir.Name
+ then
Error_Msg
(Data.Flags,
- "Casing cannot be an empty string",
- Casing_String.Location, Project);
- end if;
+ "aggregate library 'A'L'I directory cannot be shared with"
+ & " library directory of aggregated project %%",
+ The_Lib_Kind.Location, Project);
- Casing := Value (Casing_Image);
- Casing_Defined := True;
+ 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);
- exception
- when Constraint_Error =>
- Name_Len := Casing_Image'Length;
- Name_Buffer (1 .. Name_Len) := Casing_Image;
- Err_Vars.Error_Msg_Name_1 := Name_Find;
+ elsif Project.Library_Dir.Name =
+ Agg.Project.Library_Dir.Name
+ then
Error_Msg
(Data.Flags,
- "%% is not a correct Casing",
- Casing_String.Location, Project);
- end;
- end if;
+ "aggregate library directory cannot be shared with"
+ & " library directory of aggregated project %%",
+ The_Lib_Kind.Location, Project);
+ end if;
- Write_Attr ("Casing", Image (Casing));
+ if Agg.Project.Qualifier = Aggregate_Library then
+ Process_Aggregate (Agg.Project);
+ end if;
- if not Sep_Suffix.Default then
- if Length_Of_Name (Sep_Suffix.Value) = 0 then
- Error_Msg
- (Data.Flags,
- "Separate_Suffix cannot be empty",
- Sep_Suffix.Location, Project);
-
- else
- Separate_Suffix := Canonical_Case_File_Name (Sep_Suffix.Value);
- Sep_Suffix_Loc := Sep_Suffix.Location;
+ Agg := Agg.Next;
+ end loop;
+ end Process_Aggregate;
- Check_Illegal_Suffix
- (Project, Separate_Suffix,
- Dot_Replacement, "Separate_Suffix", Sep_Suffix.Location,
- Data);
- end if;
- end if;
+ -- Start of processing for Check_Aggregate_Library_Dirs
- if Separate_Suffix /= No_File then
- Write_Attr
- ("Separate_Suffix", Get_Name_String (Separate_Suffix));
+ begin
+ if Project.Qualifier = Aggregate_Library then
+ Process_Aggregate (Project);
end if;
- end Check_Common;
+ end Check_Aggregate_Library_Dirs;
- -----------------------------------
- -- Process_Exceptions_File_Based --
- -----------------------------------
+ -------------------
+ -- Check_Library --
+ -------------------
- procedure Process_Exceptions_File_Based
- (Lang_Id : Language_Ptr;
- Kind : Source_Kind)
- is
- Lang : constant Name_Id := Lang_Id.Name;
- Exceptions : Array_Element_Id;
- Exception_List : Variable_Value;
- Element_Id : String_List_Id;
- Element : String_Element;
- File_Name : File_Name_Type;
- Source : Source_Id;
+ procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
+ Src_Id : Source_Id;
+ Iter : Source_Iterator;
begin
- case Kind is
- when Impl | Sep =>
- Exceptions :=
- Value_Of
- (Name_Implementation_Exceptions,
- In_Arrays => Naming.Decl.Arrays,
- Shared => Shared);
-
- when Spec =>
- Exceptions :=
- Value_Of
- (Name_Specification_Exceptions,
- In_Arrays => Naming.Decl.Arrays,
- Shared => Shared);
- end case;
-
- Exception_List :=
- Value_Of
- (Index => Lang,
- In_Array => Exceptions,
- Shared => Shared);
+ if Proj /= No_Project then
+ if not Proj.Library then
- if Exception_List /= Nil_Variable_Value then
- Element_Id := Exception_List.Values;
- while Element_Id /= Nil_String loop
- Element := Shared.String_Elements.Table (Element_Id);
- File_Name := Canonical_Case_File_Name (Element.Value);
+ -- The only not library projects that are OK are those that
+ -- have no sources. However, header files from non-Ada
+ -- languages are OK, as there is nothing to compile.
- Source :=
- Source_Files_Htable.Get
- (Data.Tree.Source_Files_HT, File_Name);
- while Source /= No_Source
- and then Source.Project /= Project
+ Iter := For_Each_Source (Data.Tree, Proj);
loop
- Source := Source.Next_With_File_Name;
+ Src_Id := Prj.Element (Iter);
+ exit when Src_Id = No_Source
+ or else Src_Id.Language.Config.Kind /= File_Based
+ or else Src_Id.Kind /= Spec;
+ Next (Iter);
end loop;
- if Source = No_Source then
- Add_Source
- (Id => Source,
- Data => Data,
- Project => Project,
- Source_Dir_Rank => 0,
- Lang_Id => Lang_Id,
- Kind => Kind,
- File_Name => File_Name,
- Display_File => File_Name_Type (Element.Value),
- Naming_Exception => True,
- Location => Element.Location);
-
- else
- -- Check if the file name is already recorded for another
- -- language or another kind.
+ if Src_Id /= No_Source then
+ Error_Msg_Name_1 := Project.Name;
+ Error_Msg_Name_2 := Proj.Name;
- if Source.Language /= Lang_Id then
- Error_Msg
- (Data.Flags,
- "the same file cannot be a source of two languages",
- Element.Location, Project);
+ if Extends then
+ if Project.Library_Kind /= Static then
+ Error_Msg
+ (Data.Flags,
+ Continuation.all &
+ "shared library project %% cannot extend " &
+ "project %% that is not a library project",
+ Project.Location, Project);
+ Continuation := Continuation_String'Access;
+ end if;
- elsif Source.Kind /= Kind then
+ elsif not Unchecked_Shared_Lib_Imports
+ and then Project.Library_Kind /= Static
+ then
Error_Msg
(Data.Flags,
- "the same file cannot be a source and a template",
- Element.Location, Project);
+ Continuation.all &
+ "shared library project %% cannot import project %% " &
+ "that is not a shared library project",
+ Project.Location, Project);
+ Continuation := Continuation_String'Access;
end if;
-
- -- If the file is already recorded for the same
- -- language and the same kind, it means that the file
- -- name appears several times in the *_Exceptions
- -- attribute; so there is nothing to do.
end if;
- Element_Id := Element.Next;
- end loop;
- end if;
- end Process_Exceptions_File_Based;
+ 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
- -----------------------------------
- -- Process_Exceptions_Unit_Based --
- -----------------------------------
+ Error_Msg_Name_1 := Project.Name;
+ Error_Msg_Name_2 := Proj.Name;
- procedure Process_Exceptions_Unit_Based
- (Lang_Id : Language_Ptr;
- Kind : Source_Kind)
- is
- Lang : constant Name_Id := Lang_Id.Name;
- Exceptions : Array_Element_Id;
- Element : Array_Element;
- Unit : Name_Id;
- Index : Int;
- File_Name : File_Name_Type;
- Source : Source_Id;
+ 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;
- begin
- case Kind is
- when Impl | Sep =>
- Exceptions :=
- Value_Of
- (Name_Body,
- In_Arrays => Naming.Decl.Arrays,
- Shared => Shared);
+ if Extends then
+ Error_Msg
+ (Data.Flags,
+ Continuation.all &
+ "shared library project %% cannot extend static " &
+ "library project %%",
+ Project.Location, Project);
+ Continuation := Continuation_String'Access;
- if Exceptions = No_Array_Element then
- Exceptions :=
- Value_Of
- (Name_Implementation,
- In_Arrays => Naming.Decl.Arrays,
- Shared => Shared);
+ elsif not Unchecked_Shared_Lib_Imports then
+ Error_Msg
+ (Data.Flags,
+ Continuation.all &
+ "shared library project %% cannot import static " &
+ "library project %%",
+ Project.Location, Project);
+ Continuation := Continuation_String'Access;
end if;
- when Spec =>
- Exceptions :=
- Value_Of
- (Name_Spec,
- In_Arrays => Naming.Decl.Arrays,
- Shared => Shared);
+ end if;
+ end if;
+ end Check_Library;
- if Exceptions = No_Array_Element then
- Exceptions :=
- Value_Of
- (Name_Spec,
- In_Arrays => Naming.Decl.Arrays,
- Shared => Shared);
- end if;
- end case;
+ Dir_Exists : Boolean;
- while Exceptions /= No_Array_Element loop
- Element := Shared.Array_Elements.Table (Exceptions);
- File_Name := Canonical_Case_File_Name (Element.Value.Value);
+ -- Start of processing for Check_Library_Attributes
- Get_Name_String (Element.Index);
- To_Lower (Name_Buffer (1 .. Name_Len));
- Unit := Name_Find;
- Index := Element.Value.Index;
+ begin
+ Library_Directory_Present := Lib_Dir.Value /= Empty_String;
- -- For Ada, check if it is a valid unit name
+ -- Special case of extending project
- if Lang = Name_Ada then
- Get_Name_String (Element.Index);
- Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
+ if Project.Extends /= No_Project then
- if Unit = No_Name then
- Err_Vars.Error_Msg_Name_1 := Element.Index;
- Error_Msg
- (Data.Flags,
- "%% is not a valid unit name.",
- Element.Value.Location, Project);
- end if;
- end if;
+ -- If the project extended is a library project, we inherit the
+ -- library name, if it is not redefined; we check that the library
+ -- directory is specified.
- if Unit /= No_Name then
- Add_Source
- (Id => Source,
- Data => Data,
- Project => Project,
- Source_Dir_Rank => 0,
- Lang_Id => Lang_Id,
- Kind => Kind,
- File_Name => File_Name,
- Display_File => File_Name_Type (Element.Value.Value),
- Unit => Unit,
- Index => Index,
- Location => Element.Value.Location,
- Naming_Exception => True);
- end if;
+ if Project.Extends.Library then
+ if Project.Qualifier = Standard then
+ Error_Msg
+ (Data.Flags,
+ "a standard project cannot extend a library project",
+ Project.Location, Project);
- Exceptions := Element.Next;
- end loop;
- end Process_Exceptions_Unit_Based;
+ else
+ if Lib_Name.Default then
+ Project.Library_Name := Project.Extends.Library_Name;
+ end if;
- ------------------
- -- Check_Naming --
- ------------------
+ if Lib_Dir.Default then
+ if not Project.Virtual then
+ Error_Msg
+ (Data.Flags,
+ "a project extending a library project must " &
+ "specify an attribute Library_Dir",
+ Project.Location, Project);
- procedure Check_Naming is
- Dot_Replacement : File_Name_Type :=
- File_Name_Type
- (First_Name_Id + Character'Pos ('-'));
- Separate_Suffix : File_Name_Type := No_File;
- Casing : Casing_Type := All_Lower_Case;
- Casing_Defined : Boolean;
- Lang_Id : Language_Ptr;
- Sep_Suffix_Loc : Source_Ptr;
- Suffix : Variable_Value;
- Lang : Name_Id;
-
- begin
- Check_Common
- (Dot_Replacement => Dot_Replacement,
- Casing => Casing,
- Casing_Defined => Casing_Defined,
- Separate_Suffix => Separate_Suffix,
- Sep_Suffix_Loc => Sep_Suffix_Loc);
-
- -- For all unit based languages, if any, set the specified value
- -- of Dot_Replacement, Casing and/or Separate_Suffix. Do not
- -- systematically overwrite, since the defaults come from the
- -- configuration file.
-
- if Dot_Replacement /= No_File
- or else Casing_Defined
- or else Separate_Suffix /= No_File
- then
- Lang_Id := Project.Languages;
- while Lang_Id /= No_Language_Index loop
- if Lang_Id.Config.Kind = Unit_Based then
- if Dot_Replacement /= No_File then
- Lang_Id.Config.Naming_Data.Dot_Replacement :=
- Dot_Replacement;
- end if;
+ else
+ -- For a virtual project extending a library project,
+ -- inherit library directory and library kind.
- if Casing_Defined then
- Lang_Id.Config.Naming_Data.Casing := Casing;
+ Project.Library_Dir := Project.Extends.Library_Dir;
+ Library_Directory_Present := True;
+ Project.Library_Kind := Project.Extends.Library_Kind;
end if;
end if;
-
- Lang_Id := Lang_Id.Next;
- end loop;
+ end if;
end if;
+ end if;
- -- Next, get the spec and body suffixes
-
- Lang_Id := Project.Languages;
- while Lang_Id /= No_Language_Index loop
- Lang := Lang_Id.Name;
+ pragma Assert (Lib_Name.Kind = Single);
- -- Spec_Suffix
+ if Lib_Name.Value = Empty_String then
+ if Current_Verbosity = High
+ and then Project.Library_Name = No_Name
+ then
+ Debug_Indent;
+ Write_Line ("no library name");
+ end if;
- Suffix := Value_Of
- (Name => Lang,
- Attribute_Or_Array_Name => Name_Spec_Suffix,
- In_Package => Naming_Id,
- Shared => Shared);
+ else
+ -- There is no restriction on the syntax of library names
- if Suffix = Nil_Variable_Value then
- Suffix := Value_Of
- (Name => Lang,
- Attribute_Or_Array_Name => Name_Specification_Suffix,
- In_Package => Naming_Id,
- Shared => Shared);
- end if;
+ Project.Library_Name := Lib_Name.Value;
+ end if;
- if Suffix /= Nil_Variable_Value then
- Lang_Id.Config.Naming_Data.Spec_Suffix :=
- File_Name_Type (Suffix.Value);
+ if Project.Library_Name /= No_Name then
+ if Current_Verbosity = High then
+ Write_Attr
+ ("Library name: ", Get_Name_String (Project.Library_Name));
+ end if;
- Check_Illegal_Suffix
- (Project,
- Lang_Id.Config.Naming_Data.Spec_Suffix,
- Lang_Id.Config.Naming_Data.Dot_Replacement,
- "Spec_Suffix", Suffix.Location, Data);
+ pragma Assert (Lib_Dir.Kind = Single);
- Write_Attr
- ("Spec_Suffix",
- Get_Name_String (Lang_Id.Config.Naming_Data.Spec_Suffix));
- end if;
+ if not Library_Directory_Present then
+ Debug_Output ("no library directory");
- -- Body_Suffix
+ else
+ -- Find path name (unless inherited), check that it is a directory
- Suffix :=
- Value_Of
- (Name => Lang,
- Attribute_Or_Array_Name => Name_Body_Suffix,
- In_Package => Naming_Id,
- Shared => Shared);
+ if Project.Library_Dir = No_Path_Information then
+ Locate_Directory
+ (Project,
+ File_Name_Type (Lib_Dir.Value),
+ Path => Project.Library_Dir,
+ Dir_Exists => Dir_Exists,
+ Data => Data,
+ Create => "library",
+ Must_Exist => False,
+ Location => Lib_Dir.Location,
+ Externally_Built => Project.Externally_Built);
- if Suffix = Nil_Variable_Value then
- Suffix :=
- Value_Of
- (Name => Lang,
- Attribute_Or_Array_Name => Name_Implementation_Suffix,
- In_Package => Naming_Id,
- Shared => Shared);
+ else
+ Dir_Exists :=
+ Is_Directory
+ (Get_Name_String (Project.Library_Dir.Display_Name));
end if;
- if Suffix /= Nil_Variable_Value then
- Lang_Id.Config.Naming_Data.Body_Suffix :=
- File_Name_Type (Suffix.Value);
+ if not Dir_Exists then
+ if Directories_Must_Exist_In_Projects then
- -- The default value of separate suffix should be the same as
- -- the body suffix, so we need to compute that first.
+ -- Get the absolute name of the library directory that does
+ -- not exist, to report an error.
- if Separate_Suffix = No_File then
- Lang_Id.Config.Naming_Data.Separate_Suffix :=
- Lang_Id.Config.Naming_Data.Body_Suffix;
- Write_Attr
- ("Sep_Suffix",
- Get_Name_String
- (Lang_Id.Config.Naming_Data.Separate_Suffix));
- else
- Lang_Id.Config.Naming_Data.Separate_Suffix :=
- Separate_Suffix;
+ 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;
- Check_Illegal_Suffix
- (Project,
- Lang_Id.Config.Naming_Data.Body_Suffix,
- Lang_Id.Config.Naming_Data.Dot_Replacement,
- "Body_Suffix", Suffix.Location, Data);
-
- Write_Attr
- ("Body_Suffix",
- Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix));
+ -- Checks for object/source directories
- elsif Separate_Suffix /= No_File then
- Lang_Id.Config.Naming_Data.Separate_Suffix := Separate_Suffix;
- end if;
+ elsif not Project.Externally_Built
- -- Spec_Suffix cannot be equal to Body_Suffix or Separate_Suffix,
- -- since that would cause a clear ambiguity. Note that we do allow
- -- a Spec_Suffix to have the same termination as one of these,
- -- which causes a potential ambiguity, but we resolve that by
- -- matching the longest possible suffix.
+ -- An aggregate library does not have sources or objects, so
+ -- these tests are not required in this case.
- if Lang_Id.Config.Naming_Data.Spec_Suffix /= No_File
- and then Lang_Id.Config.Naming_Data.Spec_Suffix =
- Lang_Id.Config.Naming_Data.Body_Suffix
+ and then Project.Qualifier /= Aggregate_Library
then
- Error_Msg
- (Data.Flags,
- "Body_Suffix ("""
- & Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix)
- & """) cannot be the same as Spec_Suffix.",
- Ada_Body_Suffix_Loc, Project);
- end if;
+ -- Library directory cannot be the same as Object directory
- if Lang_Id.Config.Naming_Data.Body_Suffix /=
- Lang_Id.Config.Naming_Data.Separate_Suffix
- and then Lang_Id.Config.Naming_Data.Spec_Suffix =
- Lang_Id.Config.Naming_Data.Separate_Suffix
- then
- Error_Msg
- (Data.Flags,
- "Separate_Suffix ("""
- & Get_Name_String
- (Lang_Id.Config.Naming_Data.Separate_Suffix)
- & """) cannot be the same as Spec_Suffix.",
- Sep_Suffix_Loc, Project);
- end if;
+ if Project.Library_Dir.Name = Project.Object_Directory.Name then
+ Error_Msg
+ (Data.Flags,
+ "library directory cannot be the same " &
+ "as object directory",
+ Lib_Dir.Location, Project);
+ Project.Library_Dir := No_Path_Information;
- Lang_Id := Lang_Id.Next;
- end loop;
+ else
+ declare
+ OK : Boolean := True;
+ Dirs_Id : String_List_Id;
+ Dir_Elem : String_Element;
+ Pid : Project_List;
- -- Get the naming exceptions for all languages
+ begin
+ -- The library directory cannot be the same as a source
+ -- directory of the current project.
- 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);
+ Dirs_Id := Project.Source_Dirs;
+ while Dirs_Id /= Nil_String loop
+ Dir_Elem := Shared.String_Elements.Table (Dirs_Id);
+ Dirs_Id := Dir_Elem.Next;
- when Unit_Based =>
- Process_Exceptions_Unit_Based (Lang_Id, Kind);
- end case;
+ if Project.Library_Dir.Name =
+ Path_Name_Type (Dir_Elem.Value)
+ then
+ Err_Vars.Error_Msg_File_1 :=
+ File_Name_Type (Dir_Elem.Value);
+ Error_Msg
+ (Data.Flags,
+ "library directory cannot be the same "
+ & "as source directory {",
+ Lib_Dir.Location, Project);
+ OK := False;
+ exit;
+ end if;
+ end loop;
- Lang_Id := Lang_Id.Next;
- end loop;
- end loop;
- end Check_Naming;
+ if OK then
- ----------------------------
- -- Initialize_Naming_Data --
- ----------------------------
+ -- The library directory cannot be the same as a
+ -- source directory of another project either.
- procedure Initialize_Naming_Data is
- Specs : Array_Element_Id :=
- Util.Value_Of
- (Name_Spec_Suffix,
- Naming.Decl.Arrays,
- Shared);
+ Pid := Data.Tree.Projects;
+ Project_Loop : loop
+ exit Project_Loop when Pid = null;
- Impls : Array_Element_Id :=
- Util.Value_Of
- (Name_Body_Suffix,
- Naming.Decl.Arrays,
- Shared);
+ if Pid.Project /= Project then
+ Dirs_Id := Pid.Project.Source_Dirs;
- Lang : Language_Ptr;
- Lang_Name : Name_Id;
- Value : Variable_Value;
- Extended : Project_Id;
-
- begin
- -- At this stage, the project already contains the default extensions
- -- for the various languages. We now merge those suffixes read in the
- -- user project, and they override the default.
-
- while Specs /= No_Array_Element loop
- Lang_Name := Shared.Array_Elements.Table (Specs).Index;
- Lang :=
- Get_Language_From_Name
- (Project, Name => Get_Name_String (Lang_Name));
-
- -- An extending project inherits its parent projects' languages
- -- so if needed we should create entries for those languages
+ Dir_Loop : while Dirs_Id /= Nil_String loop
+ Dir_Elem :=
+ Shared.String_Elements.Table (Dirs_Id);
+ Dirs_Id := Dir_Elem.Next;
- if Lang = null then
- Extended := Project.Extends;
- while Extended /= null loop
- Lang := Get_Language_From_Name
- (Extended, Name => Get_Name_String (Lang_Name));
- exit when Lang /= null;
+ if Project.Library_Dir.Name =
+ Path_Name_Type (Dir_Elem.Value)
+ then
+ Err_Vars.Error_Msg_File_1 :=
+ File_Name_Type (Dir_Elem.Value);
+ Err_Vars.Error_Msg_Name_1 :=
+ Pid.Project.Name;
- Extended := Extended.Extends;
- end loop;
+ Error_Msg
+ (Data.Flags,
+ "library directory cannot be the same "
+ & "as source directory { of project %%",
+ Lib_Dir.Location, Project);
+ OK := False;
+ exit Project_Loop;
+ end if;
+ end loop Dir_Loop;
+ end if;
- if Lang /= null then
- Lang := new Language_Data'(Lang.all);
- Lang.First_Source := null;
- Lang.Next := Project.Languages;
- Project.Languages := Lang;
- end if;
- end if;
+ Pid := Pid.Next;
+ end loop Project_Loop;
+ end if;
- -- If language was not found in project or the projects it extends
+ if not OK then
+ Project.Library_Dir := No_Path_Information;
- if Lang = null then
- Debug_Output
- ("Ignoring spec naming data (lang. not in project): ",
- Lang_Name);
+ elsif Current_Verbosity = High then
- else
- Value := Shared.Array_Elements.Table (Specs).Value;
+ -- Display the Library directory in high verbosity
- if Value.Kind = Single then
- Lang.Config.Naming_Data.Spec_Suffix :=
- Canonical_Case_File_Name (Value.Value);
+ Write_Attr
+ ("Library directory",
+ Get_Name_String (Project.Library_Dir.Display_Name));
+ end if;
+ end;
end if;
end if;
+ end if;
- Specs := Shared.Array_Elements.Table (Specs).Next;
- end loop;
-
- while Impls /= No_Array_Element loop
- Lang_Name := Shared.Array_Elements.Table (Impls).Index;
- Lang :=
- Get_Language_From_Name
- (Project, Name => Get_Name_String (Lang_Name));
-
- if Lang = null then
- Debug_Output
- ("Ignoring impl naming data (lang. not in project): ",
- Lang_Name);
- else
- Value := Shared.Array_Elements.Table (Impls).Value;
+ end if;
- if Lang.Name = Name_Ada then
- Ada_Body_Suffix_Loc := Value.Location;
- end if;
+ Project.Library :=
+ Project.Library_Dir /= No_Path_Information
+ and then Project.Library_Name /= No_Name;
- if Value.Kind = Single then
- Lang.Config.Naming_Data.Body_Suffix :=
- Canonical_Case_File_Name (Value.Value);
+ if Project.Extends = No_Project then
+ case Project.Qualifier is
+ when Standard =>
+ if Project.Library then
+ Error_Msg
+ (Data.Flags,
+ "a standard project cannot be a library project",
+ Lib_Name.Location, Project);
end if;
- end if;
- Impls := Shared.Array_Elements.Table (Impls).Next;
- end loop;
- end Initialize_Naming_Data;
+ when Library | Aggregate_Library =>
+ if not Project.Library then
+ if Project.Library_Name = No_Name then
+ Error_Msg
+ (Data.Flags,
+ "attribute Library_Name not declared",
+ Project.Location, Project);
- -- Start of processing for Check_Naming_Schemes
+ if not Library_Directory_Present then
+ Error_Msg
+ (Data.Flags,
+ "\attribute Library_Dir not declared",
+ Project.Location, Project);
+ end if;
- begin
- -- No Naming package or parsing a configuration file? nothing to do
+ elsif Project.Library_Dir = No_Path_Information then
+ Error_Msg
+ (Data.Flags,
+ "attribute Library_Dir not declared",
+ Project.Location, Project);
+ end if;
+ end if;
- if Naming_Id /= No_Package
- and then Project.Qualifier /= Configuration
- then
- Naming := Shared.Packages.Table (Naming_Id);
- Debug_Increase_Indent ("Checking package Naming for ", Project.Name);
- Initialize_Naming_Data;
- Check_Naming;
- Debug_Decrease_Indent ("Done checking package naming");
+ when others =>
+ null;
+ end case;
end if;
- end Check_Package_Naming;
- ------------------------------
- -- Check_Library_Attributes --
- ------------------------------
+ if Project.Library then
+ Support_For_Libraries := Project.Config.Lib_Support;
- procedure Check_Library_Attributes
- (Project : Project_Id;
- Data : in out Tree_Processing_Data)
- is
- Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
+ 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_Name.Location, Project);
+ Project.Library := False;
- Attributes : constant Prj.Variable_Id := Project.Decl.Attributes;
+ else
+ if Lib_ALI_Dir.Value = Empty_String then
+ Debug_Output ("no library ALI directory specified");
+ Project.Library_ALI_Dir := Project.Library_Dir;
- Lib_Dir : constant Prj.Variable_Value :=
- Prj.Util.Value_Of
- (Snames.Name_Library_Dir, Attributes, Shared);
+ else
+ -- Find path name, check that it is a directory
- Lib_Name : constant Prj.Variable_Value :=
- Prj.Util.Value_Of
- (Snames.Name_Library_Name, Attributes, Shared);
+ Locate_Directory
+ (Project,
+ File_Name_Type (Lib_ALI_Dir.Value),
+ Path => Project.Library_ALI_Dir,
+ Create => "library ALI",
+ Dir_Exists => Dir_Exists,
+ Data => Data,
+ Must_Exist => False,
+ Location => Lib_ALI_Dir.Location,
+ Externally_Built => Project.Externally_Built);
- Lib_Version : constant Prj.Variable_Value :=
- Prj.Util.Value_Of
- (Snames.Name_Library_Version, Attributes, Shared);
+ if not Dir_Exists then
- Lib_ALI_Dir : constant Prj.Variable_Value :=
- Prj.Util.Value_Of
- (Snames.Name_Library_Ali_Dir, Attributes, Shared);
+ -- Get the absolute name of the library ALI directory that
+ -- does not exist, to report an error.
- Lib_GCC : constant Prj.Variable_Value :=
- Prj.Util.Value_Of
- (Snames.Name_Library_GCC, Attributes, Shared);
+ Err_Vars.Error_Msg_File_1 :=
+ File_Name_Type (Project.Library_ALI_Dir.Display_Name);
+ Error_Msg
+ (Data.Flags,
+ "library 'A'L'I directory { does not exist",
+ Lib_ALI_Dir.Location, Project);
+ end if;
- The_Lib_Kind : constant Prj.Variable_Value :=
- Prj.Util.Value_Of
- (Snames.Name_Library_Kind, Attributes, Shared);
+ 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.
- Imported_Project_List : Project_List;
+ if Project.Library_ALI_Dir = Project.Object_Directory then
+ Error_Msg
+ (Data.Flags,
+ "library 'A'L'I directory cannot be the same " &
+ "as object directory",
+ Lib_ALI_Dir.Location, Project);
+ Project.Library_ALI_Dir := No_Path_Information;
- Continuation : String_Access := No_Continuation_String'Access;
+ else
+ declare
+ OK : Boolean := True;
+ Dirs_Id : String_List_Id;
+ Dir_Elem : String_Element;
+ Pid : Project_List;
- Support_For_Libraries : Library_Support;
+ begin
+ -- The library ALI directory cannot be the same as
+ -- a source directory of the current project.
- Library_Directory_Present : Boolean;
+ Dirs_Id := Project.Source_Dirs;
+ while Dirs_Id /= Nil_String loop
+ Dir_Elem := Shared.String_Elements.Table (Dirs_Id);
+ Dirs_Id := Dir_Elem.Next;
- procedure Check_Library (Proj : Project_Id; Extends : Boolean);
- -- Check if an imported or extended project if also a library project
+ if Project.Library_ALI_Dir.Name =
+ Path_Name_Type (Dir_Elem.Value)
+ then
+ Err_Vars.Error_Msg_File_1 :=
+ File_Name_Type (Dir_Elem.Value);
+ Error_Msg
+ (Data.Flags,
+ "library 'A'L'I directory cannot be " &
+ "the same as source directory {",
+ Lib_ALI_Dir.Location, Project);
+ OK := False;
+ exit;
+ end if;
+ end loop;
- -------------------
- -- Check_Library --
- -------------------
+ if OK then
- procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
- Src_Id : Source_Id;
- Iter : Source_Iterator;
+ -- The library ALI directory cannot be the same as
+ -- a source directory of another project either.
- begin
- if Proj /= No_Project then
- if not Proj.Library then
+ Pid := Data.Tree.Projects;
+ ALI_Project_Loop : loop
+ exit ALI_Project_Loop when Pid = null;
- -- The only not library projects that are OK are those that
- -- have no sources. However, header files from non-Ada
- -- languages are OK, as there is nothing to compile.
+ if Pid.Project /= Project then
+ Dirs_Id := Pid.Project.Source_Dirs;
- Iter := For_Each_Source (Data.Tree, Proj);
- loop
- Src_Id := Prj.Element (Iter);
- exit when Src_Id = No_Source
- or else Src_Id.Language.Config.Kind /= File_Based
- or else Src_Id.Kind /= Spec;
- Next (Iter);
- end loop;
+ ALI_Dir_Loop :
+ while Dirs_Id /= Nil_String loop
+ Dir_Elem :=
+ Shared.String_Elements.Table (Dirs_Id);
+ Dirs_Id := Dir_Elem.Next;
- if Src_Id /= No_Source then
- Error_Msg_Name_1 := Project.Name;
- Error_Msg_Name_2 := Proj.Name;
+ if Project.Library_ALI_Dir.Name =
+ Path_Name_Type (Dir_Elem.Value)
+ then
+ Err_Vars.Error_Msg_File_1 :=
+ File_Name_Type (Dir_Elem.Value);
+ Err_Vars.Error_Msg_Name_1 :=
+ Pid.Project.Name;
- if Extends then
- if Project.Library_Kind /= Static then
- Error_Msg
- (Data.Flags,
- Continuation.all &
- "shared library project %% cannot extend " &
- "project %% that is not a library project",
- Project.Location, Project);
- Continuation := Continuation_String'Access;
- end if;
+ Error_Msg
+ (Data.Flags,
+ "library 'A'L'I directory cannot " &
+ "be the same as source directory " &
+ "{ of project %%",
+ Lib_ALI_Dir.Location, Project);
+ OK := False;
+ exit ALI_Project_Loop;
+ end if;
+ end loop ALI_Dir_Loop;
+ end if;
+ Pid := Pid.Next;
+ end loop ALI_Project_Loop;
+ end if;
- elsif (not Unchecked_Shared_Lib_Imports)
- and then Project.Library_Kind /= Static
- then
- Error_Msg
- (Data.Flags,
- Continuation.all &
- "shared library project %% cannot import project %% " &
- "that is not a shared library project",
- Project.Location, Project);
- Continuation := Continuation_String'Access;
- end if;
- end if;
+ if not OK then
+ Project.Library_ALI_Dir := No_Path_Information;
- elsif Project.Library_Kind /= Static and then
- Proj.Library_Kind = Static
- then
- Error_Msg_Name_1 := Project.Name;
- Error_Msg_Name_2 := Proj.Name;
+ elsif Current_Verbosity = High then
- if Extends then
- Error_Msg
- (Data.Flags,
- Continuation.all &
- "shared library project %% cannot extend static " &
- "library project %%",
- Project.Location, Project);
- Continuation := Continuation_String'Access;
+ -- Display Library ALI directory in high verbosity
- elsif not Unchecked_Shared_Lib_Imports then
- Error_Msg
- (Data.Flags,
- Continuation.all &
- "shared library project %% cannot import static " &
- "library project %%",
- Project.Location, Project);
- Continuation := Continuation_String'Access;
+ Write_Attr
+ ("Library ALI dir",
+ Get_Name_String
+ (Project.Library_ALI_Dir.Display_Name));
+ end if;
+ end;
+ end if;
end if;
+ end if;
+
+ pragma Assert (Lib_Version.Kind = Single);
+
+ if Lib_Version.Value = Empty_String then
+ Debug_Output ("no library version specified");
+ else
+ Project.Lib_Internal_Name := Lib_Version.Value;
end if;
- end if;
- end Check_Library;
- Dir_Exists : Boolean;
+ pragma Assert (The_Lib_Kind.Kind = Single);
- -- Start of processing for Check_Library_Attributes
+ if The_Lib_Kind.Value = Empty_String then
+ Debug_Output ("no library kind specified");
- begin
- Library_Directory_Present := Lib_Dir.Value /= Empty_String;
+ else
+ Get_Name_String (The_Lib_Kind.Value);
- -- Special case of extending project
+ declare
+ Kind_Name : constant String :=
+ To_Lower (Name_Buffer (1 .. Name_Len));
- if Project.Extends /= No_Project then
+ OK : Boolean := True;
- -- If the project extended is a library project, we inherit the
- -- library name, if it is not redefined; we check that the library
- -- directory is specified.
+ begin
+ if Kind_Name = "static" then
+ Project.Library_Kind := Static;
- if Project.Extends.Library then
- if Project.Qualifier = Standard then
- Error_Msg
- (Data.Flags,
- "a standard project cannot extend a library project",
- Project.Location, Project);
+ elsif Kind_Name = "dynamic" then
+ Project.Library_Kind := Dynamic;
- else
- if Lib_Name.Default then
- Project.Library_Name := Project.Extends.Library_Name;
- end if;
+ elsif Kind_Name = "relocatable" then
+ Project.Library_Kind := Relocatable;
- if Lib_Dir.Default then
- if not Project.Virtual then
+ else
Error_Msg
(Data.Flags,
- "a project extending a library project must " &
- "specify an attribute Library_Dir",
- Project.Location, Project);
-
- else
- -- For a virtual project extending a library project,
- -- inherit library directory and library kind.
-
- Project.Library_Dir := Project.Extends.Library_Dir;
- Library_Directory_Present := True;
- Project.Library_Kind := Project.Extends.Library_Kind;
+ "illegal value for Library_Kind",
+ The_Lib_Kind.Location, Project);
+ OK := False;
end if;
- end if;
- end if;
- end if;
- end if;
- pragma Assert (Lib_Name.Kind = Single);
-
- if Lib_Name.Value = Empty_String then
- if Current_Verbosity = High
- and then Project.Library_Name = No_Name
- then
- Debug_Indent;
- Write_Line ("No library name");
- end if;
+ if Current_Verbosity = High and then OK then
+ Write_Attr ("Library kind", Kind_Name);
+ end if;
- else
- -- There is no restriction on the syntax of library names
+ if Project.Library_Kind /= Static then
+ if not Project.Externally_Built
+ and then Support_For_Libraries = Prj.Static_Only
+ then
+ Error_Msg
+ (Data.Flags,
+ "only static libraries are supported " &
+ "on this platform",
+ The_Lib_Kind.Location, Project);
+ Project.Library := False;
- Project.Library_Name := Lib_Name.Value;
- end if;
+ else
+ -- Check if (obsolescent) attribute Library_GCC or
+ -- Linker'Driver is declared.
- if Project.Library_Name /= No_Name then
- if Current_Verbosity = High then
- Write_Attr ("Library name: ",
- Get_Name_String (Project.Library_Name));
- end if;
+ if Lib_GCC.Value /= Empty_String then
+ Error_Msg
+ (Data.Flags,
+ "?Library_'G'C'C is an obsolescent attribute, " &
+ "use Linker''Driver instead",
+ Lib_GCC.Location, Project);
+ Project.Config.Shared_Lib_Driver :=
+ File_Name_Type (Lib_GCC.Value);
- pragma Assert (Lib_Dir.Kind = Single);
+ else
+ declare
+ Linker : constant Package_Id :=
+ Value_Of
+ (Name_Linker,
+ Project.Decl.Packages,
+ Shared);
+ Driver : constant Variable_Value :=
+ Value_Of
+ (Name => No_Name,
+ Attribute_Or_Array_Name =>
+ Name_Driver,
+ In_Package => Linker,
+ Shared => Shared);
- if not Library_Directory_Present then
- Debug_Output ("No library directory");
+ begin
+ if Driver /= Nil_Variable_Value
+ and then Driver.Value /= Empty_String
+ then
+ Project.Config.Shared_Lib_Driver :=
+ File_Name_Type (Driver.Value);
+ end if;
+ end;
+ end if;
+ end if;
+ end if;
+ end;
+ end if;
- else
- -- Find path name (unless inherited), check that it is a directory
+ if Project.Library
+ and then Project.Qualifier /= Aggregate_Library
+ then
+ Debug_Output ("this is a library project file");
- if Project.Library_Dir = No_Path_Information then
- Locate_Directory
- (Project,
- File_Name_Type (Lib_Dir.Value),
- Path => Project.Library_Dir,
- Dir_Exists => Dir_Exists,
- Data => Data,
- Create => "library",
- Must_Exist => False,
- Location => Lib_Dir.Location,
- Externally_Built => Project.Externally_Built);
+ Check_Library (Project.Extends, Extends => True);
- else
- Dir_Exists :=
- Is_Directory
- (Get_Name_String
- (Project.Library_Dir.Display_Name));
+ Imported_Project_List := Project.Imported_Projects;
+ while Imported_Project_List /= null loop
+ Check_Library
+ (Imported_Project_List.Project,
+ Extends => False);
+ Imported_Project_List := Imported_Project_List.Next;
+ end loop;
end if;
+ end if;
+ end if;
- if not Dir_Exists then
-
- -- Get the absolute name of the library directory that
- -- does not exist, to report an error.
+ -- Check if Linker'Switches or Linker'Default_Switches are declared.
+ -- Warn if they are declared, as it is a common error to think that
+ -- library are "linked" with Linker switches.
- 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);
+ if Project.Library then
+ declare
+ Linker_Package_Id : constant Package_Id :=
+ Util.Value_Of
+ (Name_Linker,
+ Project.Decl.Packages, Shared);
+ Linker_Package : Package_Element;
+ Switches : Array_Element_Id := No_Array_Element;
- elsif not Project.Externally_Built then
+ begin
+ if Linker_Package_Id /= No_Package then
+ Linker_Package := Shared.Packages.Table (Linker_Package_Id);
- -- The library directory cannot be the same as the Object
- -- directory.
+ Switches :=
+ Value_Of
+ (Name => Name_Switches,
+ In_Arrays => Linker_Package.Decl.Arrays,
+ Shared => Shared);
- if Project.Library_Dir.Name = Project.Object_Directory.Name then
- Error_Msg
- (Data.Flags,
- "library directory cannot be the same " &
- "as object directory",
- Lib_Dir.Location, Project);
- Project.Library_Dir := No_Path_Information;
+ if Switches = No_Array_Element then
+ Switches :=
+ Value_Of
+ (Name => Name_Default_Switches,
+ In_Arrays => Linker_Package.Decl.Arrays,
+ Shared => Shared);
+ end if;
- else
- declare
- OK : Boolean := True;
- Dirs_Id : String_List_Id;
- Dir_Elem : String_Element;
- Pid : Project_List;
+ if Switches /= No_Array_Element then
+ Error_Msg
+ (Data.Flags,
+ "?\Linker switches not taken into account in library " &
+ "projects",
+ No_Location, Project);
+ end if;
+ end if;
+ end;
+ end if;
- begin
- -- The library directory cannot be the same as a source
- -- directory of the current project.
+ if Project.Extends /= No_Project and then Project.Extends.Library then
- Dirs_Id := Project.Source_Dirs;
- while Dirs_Id /= Nil_String loop
- Dir_Elem := Shared.String_Elements.Table (Dirs_Id);
- Dirs_Id := Dir_Elem.Next;
+ -- Remove the library name from Lib_Data_Table
- if Project.Library_Dir.Name =
- Path_Name_Type (Dir_Elem.Value)
- then
- Err_Vars.Error_Msg_File_1 :=
- File_Name_Type (Dir_Elem.Value);
- Error_Msg
- (Data.Flags,
- "library directory cannot be the same " &
- "as source directory {",
- Lib_Dir.Location, Project);
- OK := False;
- exit;
- end if;
- end loop;
+ for J in 1 .. Lib_Data_Table.Last loop
+ if Lib_Data_Table.Table (J).Proj = Project.Extends then
+ Lib_Data_Table.Table (J) :=
+ Lib_Data_Table.Table (Lib_Data_Table.Last);
+ Lib_Data_Table.Set_Last (Lib_Data_Table.Last - 1);
+ exit;
+ end if;
+ end loop;
+ end if;
- if OK then
+ if Project.Library and then not Lib_Name.Default then
- -- The library directory cannot be the same as a
- -- source directory of another project either.
+ -- Check if the same library name is used in an other library project
- Pid := Data.Tree.Projects;
- Project_Loop : loop
- exit Project_Loop when Pid = null;
+ for J in 1 .. Lib_Data_Table.Last loop
+ 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,
+ "Library name cannot be the same as in project %%",
+ Lib_Name.Location, Project);
+ Project.Library := False;
+ exit;
+ end if;
+ end loop;
+ end if;
- if Pid.Project /= Project then
- Dirs_Id := Pid.Project.Source_Dirs;
+ if not Lib_Standalone.Default
+ and then Project.Library_Kind = Static
+ then
+ -- An standalone library must be a shared library
- Dir_Loop : while Dirs_Id /= Nil_String loop
- Dir_Elem :=
- Shared.String_Elements.Table (Dirs_Id);
- Dirs_Id := Dir_Elem.Next;
+ Error_Msg_Name_1 := Project.Name;
- if Project.Library_Dir.Name =
- Path_Name_Type (Dir_Elem.Value)
- then
- Err_Vars.Error_Msg_File_1 :=
- File_Name_Type (Dir_Elem.Value);
- Err_Vars.Error_Msg_Name_1 :=
- Pid.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;
- Error_Msg
- (Data.Flags,
- "library directory cannot be the same" &
- " as source directory { of project %%",
- Lib_Dir.Location, Project);
- OK := False;
- exit Project_Loop;
- end if;
- end loop Dir_Loop;
- end if;
+ -- Check that aggregated libraries do not share the aggregate
+ -- Library_ALI_Dir.
- Pid := Pid.Next;
- end loop Project_Loop;
- end if;
+ if Project.Qualifier = Aggregate_Library then
+ Check_Aggregate_Library_Dirs;
+ end if;
- if not OK then
- Project.Library_Dir := No_Path_Information;
+ if Project.Library and not Data.In_Aggregate_Lib then
- elsif Current_Verbosity = High then
+ -- Record the library name
- -- Display the Library directory in high verbosity
+ Lib_Data_Table.Append
+ ((Name => Project.Library_Name,
+ Proj => Project,
+ Tree => Data.Tree));
+ end if;
+ end Check_Library_Attributes;
- Write_Attr
- ("Library directory",
- Get_Name_String (Project.Library_Dir.Display_Name));
- end if;
- end;
- end if;
+ --------------------------
+ -- Check_Package_Naming --
+ --------------------------
+
+ procedure Check_Package_Naming
+ (Project : Project_Id;
+ Data : in out Tree_Processing_Data)
+ is
+ Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
+ Naming_Id : constant Package_Id :=
+ Util.Value_Of
+ (Name_Naming, Project.Decl.Packages, Shared);
+ Naming : Package_Element;
+
+ Ada_Body_Suffix_Loc : Source_Ptr := No_Location;
+
+ procedure Check_Naming;
+ -- Check the validity of the Naming package (suffixes valid, ...)
+
+ procedure Check_Common
+ (Dot_Replacement : in out File_Name_Type;
+ Casing : in out Casing_Type;
+ Casing_Defined : out Boolean;
+ Separate_Suffix : in out File_Name_Type;
+ Sep_Suffix_Loc : out Source_Ptr);
+ -- Check attributes common
+
+ procedure Process_Exceptions_File_Based
+ (Lang_Id : Language_Ptr;
+ Kind : Source_Kind);
+ procedure Process_Exceptions_Unit_Based
+ (Lang_Id : Language_Ptr;
+ Kind : Source_Kind);
+ -- Process the naming exceptions for the two types of languages
+
+ procedure Initialize_Naming_Data;
+ -- Initialize internal naming data for the various languages
+
+ ------------------
+ -- Check_Common --
+ ------------------
+
+ procedure Check_Common
+ (Dot_Replacement : in out File_Name_Type;
+ Casing : in out Casing_Type;
+ Casing_Defined : out Boolean;
+ Separate_Suffix : in out File_Name_Type;
+ Sep_Suffix_Loc : out Source_Ptr)
+ is
+ Dot_Repl : constant Variable_Value :=
+ Util.Value_Of
+ (Name_Dot_Replacement,
+ Naming.Decl.Attributes,
+ Shared);
+ Casing_String : constant Variable_Value :=
+ Util.Value_Of
+ (Name_Casing,
+ Naming.Decl.Attributes,
+ Shared);
+ Sep_Suffix : constant Variable_Value :=
+ Util.Value_Of
+ (Name_Separate_Suffix,
+ Naming.Decl.Attributes,
+ Shared);
+ Dot_Repl_Loc : Source_Ptr;
+
+ begin
+ Sep_Suffix_Loc := No_Location;
+
+ if not Dot_Repl.Default then
+ pragma Assert
+ (Dot_Repl.Kind = Single, "Dot_Replacement is not a string");
+
+ if Length_Of_Name (Dot_Repl.Value) = 0 then
+ Error_Msg
+ (Data.Flags, "Dot_Replacement cannot be empty",
+ Dot_Repl.Location, Project);
end if;
+
+ Dot_Replacement := Canonical_Case_File_Name (Dot_Repl.Value);
+ Dot_Repl_Loc := Dot_Repl.Location;
+
+ declare
+ Repl : constant String := Get_Name_String (Dot_Replacement);
+
+ begin
+ -- Dot_Replacement cannot
+ -- - be empty
+ -- - start or end with an alphanumeric
+ -- - be a single '_'
+ -- - start with an '_' followed by an alphanumeric
+ -- - contain a '.' except if it is "."
+
+ if Repl'Length = 0
+ or else Is_Alphanumeric (Repl (Repl'First))
+ or else Is_Alphanumeric (Repl (Repl'Last))
+ or else (Repl (Repl'First) = '_'
+ and then
+ (Repl'Length = 1
+ or else
+ Is_Alphanumeric (Repl (Repl'First + 1))))
+ or else (Repl'Length > 1
+ and then
+ Index (Source => Repl, Pattern => ".") /= 0)
+ then
+ Error_Msg
+ (Data.Flags,
+ '"' & Repl &
+ """ is illegal for Dot_Replacement.",
+ Dot_Repl_Loc, Project);
+ end if;
+ end;
end if;
- end if;
+ if Dot_Replacement /= No_File then
+ Write_Attr
+ ("Dot_Replacement", Get_Name_String (Dot_Replacement));
+ end if;
- Project.Library :=
- Project.Library_Dir /= No_Path_Information
- and then Project.Library_Name /= No_Name;
+ Casing_Defined := False;
- if Project.Extends = No_Project then
- case Project.Qualifier is
- when Standard =>
- if Project.Library then
+ if not Casing_String.Default then
+ pragma Assert
+ (Casing_String.Kind = Single, "Casing is not a string");
+
+ declare
+ Casing_Image : constant String :=
+ Get_Name_String (Casing_String.Value);
+
+ begin
+ if Casing_Image'Length = 0 then
Error_Msg
(Data.Flags,
- "a standard project cannot be a library project",
- Lib_Name.Location, Project);
+ "Casing cannot be an empty string",
+ Casing_String.Location, Project);
end if;
- when Library =>
- if not Project.Library then
- if Project.Library_Name = No_Name then
+ Casing := Value (Casing_Image);
+ Casing_Defined := True;
+
+ exception
+ when Constraint_Error =>
+ Name_Len := Casing_Image'Length;
+ Name_Buffer (1 .. Name_Len) := Casing_Image;
+ Err_Vars.Error_Msg_Name_1 := Name_Find;
+ Error_Msg
+ (Data.Flags,
+ "%% is not a correct Casing",
+ Casing_String.Location, Project);
+ end;
+ end if;
+
+ Write_Attr ("Casing", Image (Casing));
+
+ if not Sep_Suffix.Default then
+ if Length_Of_Name (Sep_Suffix.Value) = 0 then
+ Error_Msg
+ (Data.Flags,
+ "Separate_Suffix cannot be empty",
+ Sep_Suffix.Location, Project);
+
+ else
+ Separate_Suffix := Canonical_Case_File_Name (Sep_Suffix.Value);
+ Sep_Suffix_Loc := Sep_Suffix.Location;
+
+ Check_Illegal_Suffix
+ (Project, Separate_Suffix,
+ Dot_Replacement, "Separate_Suffix", Sep_Suffix.Location,
+ Data);
+ end if;
+ end if;
+
+ if Separate_Suffix /= No_File then
+ Write_Attr
+ ("Separate_Suffix", Get_Name_String (Separate_Suffix));
+ end if;
+ end Check_Common;
+
+ -----------------------------------
+ -- Process_Exceptions_File_Based --
+ -----------------------------------
+
+ procedure Process_Exceptions_File_Based
+ (Lang_Id : Language_Ptr;
+ Kind : Source_Kind)
+ is
+ Lang : constant Name_Id := Lang_Id.Name;
+ Exceptions : Array_Element_Id;
+ Exception_List : Variable_Value;
+ Element_Id : String_List_Id;
+ Element : String_Element;
+ File_Name : File_Name_Type;
+ Source : Source_Id;
+
+ begin
+ case Kind is
+ when Impl | Sep =>
+ Exceptions :=
+ Value_Of
+ (Name_Implementation_Exceptions,
+ In_Arrays => Naming.Decl.Arrays,
+ Shared => Shared);
+
+ when Spec =>
+ Exceptions :=
+ Value_Of
+ (Name_Specification_Exceptions,
+ In_Arrays => Naming.Decl.Arrays,
+ Shared => Shared);
+ end case;
+
+ Exception_List :=
+ Value_Of
+ (Index => Lang,
+ In_Array => Exceptions,
+ Shared => Shared);
+
+ if Exception_List /= Nil_Variable_Value then
+ Element_Id := Exception_List.Values;
+ while Element_Id /= Nil_String loop
+ Element := Shared.String_Elements.Table (Element_Id);
+ File_Name := Canonical_Case_File_Name (Element.Value);
+
+ Source :=
+ Source_Files_Htable.Get
+ (Data.Tree.Source_Files_HT, File_Name);
+ while Source /= No_Source
+ and then Source.Project /= Project
+ loop
+ Source := Source.Next_With_File_Name;
+ end loop;
+
+ if Source = No_Source then
+ Add_Source
+ (Id => Source,
+ Data => Data,
+ Project => Project,
+ Source_Dir_Rank => 0,
+ Lang_Id => Lang_Id,
+ Kind => Kind,
+ File_Name => File_Name,
+ Display_File => File_Name_Type (Element.Value),
+ Naming_Exception => Yes,
+ Location => Element.Location);
+
+ else
+ -- Check if the file name is already recorded for another
+ -- language or another kind.
+
+ if Source.Language /= Lang_Id then
Error_Msg
(Data.Flags,
- "attribute Library_Name not declared",
- Project.Location, Project);
-
- if not Library_Directory_Present then
- Error_Msg
- (Data.Flags,
- "\attribute Library_Dir not declared",
- Project.Location, Project);
- end if;
+ "the same file cannot be a source of two languages",
+ Element.Location, Project);
- elsif Project.Library_Dir = No_Path_Information then
+ elsif Source.Kind /= Kind then
Error_Msg
(Data.Flags,
- "attribute Library_Dir not declared",
- Project.Location, Project);
+ "the same file cannot be a source and a template",
+ Element.Location, Project);
end if;
+
+ -- If the file is already recorded for the same
+ -- language and the same kind, it means that the file
+ -- name appears several times in the *_Exceptions
+ -- attribute; so there is nothing to do.
end if;
- when others =>
- null;
+ Element_Id := Element.Next;
+ end loop;
+ end if;
+ end Process_Exceptions_File_Based;
- end case;
- end if;
+ -----------------------------------
+ -- Process_Exceptions_Unit_Based --
+ -----------------------------------
- if Project.Library then
- Support_For_Libraries := Project.Config.Lib_Support;
+ procedure Process_Exceptions_Unit_Based
+ (Lang_Id : Language_Ptr;
+ Kind : Source_Kind)
+ is
+ Exceptions : Array_Element_Id;
+ Element : Array_Element;
+ Unit : Name_Id;
+ Index : Int;
+ File_Name : File_Name_Type;
+ Source : Source_Id;
- if Support_For_Libraries = Prj.None then
- Error_Msg
- (Data.Flags,
- "?libraries are not supported on this platform",
- Lib_Name.Location, Project);
- Project.Library := False;
+ Naming_Exception : Naming_Exception_Type;
+
+ begin
+ case Kind is
+ when Impl | Sep =>
+ Exceptions :=
+ Value_Of
+ (Name_Body,
+ In_Arrays => Naming.Decl.Arrays,
+ Shared => Shared);
+
+ if Exceptions = No_Array_Element then
+ Exceptions :=
+ Value_Of
+ (Name_Implementation,
+ In_Arrays => Naming.Decl.Arrays,
+ Shared => Shared);
+ end if;
+
+ when Spec =>
+ Exceptions :=
+ Value_Of
+ (Name_Spec,
+ In_Arrays => Naming.Decl.Arrays,
+ Shared => Shared);
+
+ if Exceptions = No_Array_Element then
+ Exceptions :=
+ Value_Of
+ (Name_Specification,
+ In_Arrays => Naming.Decl.Arrays,
+ Shared => Shared);
+ end if;
+ end case;
- else
- if Lib_ALI_Dir.Value = Empty_String then
- Debug_Output ("No library ALI directory specified");
- Project.Library_ALI_Dir := Project.Library_Dir;
+ while Exceptions /= No_Array_Element loop
+ Element := Shared.Array_Elements.Table (Exceptions);
+ if Element.Restricted then
+ Naming_Exception := Inherited;
else
- -- Find path name, check that it is a directory
+ Naming_Exception := Yes;
+ end if;
- Locate_Directory
- (Project,
- File_Name_Type (Lib_ALI_Dir.Value),
- Path => Project.Library_ALI_Dir,
- Create => "library ALI",
- Dir_Exists => Dir_Exists,
- Data => Data,
- Must_Exist => False,
- Location => Lib_ALI_Dir.Location,
- Externally_Built => Project.Externally_Built);
+ File_Name := Canonical_Case_File_Name (Element.Value.Value);
- if not Dir_Exists then
+ Get_Name_String (Element.Index);
+ To_Lower (Name_Buffer (1 .. Name_Len));
+ Index := Element.Value.Index;
- -- Get the absolute name of the library ALI directory that
- -- does not exist, to report an error.
+ -- Check if it is a valid unit name
- Err_Vars.Error_Msg_File_1 :=
- File_Name_Type (Project.Library_ALI_Dir.Display_Name);
- Error_Msg
- (Data.Flags,
- "library 'A'L'I directory { does not exist",
- Lib_ALI_Dir.Location, Project);
- end if;
+ Get_Name_String (Element.Index);
+ Check_Unit_Name (Name_Buffer (1 .. Name_Len), Unit);
- 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.
+ if Unit = No_Name then
+ Err_Vars.Error_Msg_Name_1 := Element.Index;
+ Error_Msg
+ (Data.Flags,
+ "%% is not a valid unit name.",
+ Element.Value.Location, Project);
+ end if;
- if Project.Library_ALI_Dir = Project.Object_Directory then
- Error_Msg
- (Data.Flags,
- "library 'A'L'I directory cannot be the same " &
- "as object directory",
- Lib_ALI_Dir.Location, Project);
- Project.Library_ALI_Dir := No_Path_Information;
+ if Unit /= No_Name then
+ Add_Source
+ (Id => Source,
+ Data => Data,
+ Project => Project,
+ Source_Dir_Rank => 0,
+ Lang_Id => Lang_Id,
+ Kind => Kind,
+ File_Name => File_Name,
+ Display_File => File_Name_Type (Element.Value.Value),
+ Unit => Unit,
+ Index => Index,
+ Location => Element.Value.Location,
+ Naming_Exception => Naming_Exception);
+ end if;
- else
- declare
- OK : Boolean := True;
- Dirs_Id : String_List_Id;
- Dir_Elem : String_Element;
- Pid : Project_List;
+ Exceptions := Element.Next;
+ end loop;
+ end Process_Exceptions_Unit_Based;
- begin
- -- The library ALI directory cannot be the same as
- -- a source directory of the current project.
+ ------------------
+ -- Check_Naming --
+ ------------------
- Dirs_Id := Project.Source_Dirs;
- while Dirs_Id /= Nil_String loop
- Dir_Elem := Shared.String_Elements.Table (Dirs_Id);
- Dirs_Id := Dir_Elem.Next;
+ procedure Check_Naming is
+ Dot_Replacement : File_Name_Type :=
+ File_Name_Type
+ (First_Name_Id + Character'Pos ('-'));
+ Separate_Suffix : File_Name_Type := No_File;
+ Casing : Casing_Type := All_Lower_Case;
+ Casing_Defined : Boolean;
+ Lang_Id : Language_Ptr;
+ Sep_Suffix_Loc : Source_Ptr;
+ Suffix : Variable_Value;
+ Lang : Name_Id;
- if Project.Library_ALI_Dir.Name =
- Path_Name_Type (Dir_Elem.Value)
- then
- Err_Vars.Error_Msg_File_1 :=
- File_Name_Type (Dir_Elem.Value);
- Error_Msg
- (Data.Flags,
- "library 'A'L'I directory cannot be " &
- "the same as source directory {",
- Lib_ALI_Dir.Location, Project);
- OK := False;
- exit;
- end if;
- end loop;
+ begin
+ Check_Common
+ (Dot_Replacement => Dot_Replacement,
+ Casing => Casing,
+ Casing_Defined => Casing_Defined,
+ Separate_Suffix => Separate_Suffix,
+ Sep_Suffix_Loc => Sep_Suffix_Loc);
- if OK then
+ -- For all unit based languages, if any, set the specified value
+ -- of Dot_Replacement, Casing and/or Separate_Suffix. Do not
+ -- systematically overwrite, since the defaults come from the
+ -- configuration file.
- -- The library ALI directory cannot be the same as
- -- a source directory of another project either.
+ if Dot_Replacement /= No_File
+ or else Casing_Defined
+ or else Separate_Suffix /= No_File
+ then
+ Lang_Id := Project.Languages;
+ while Lang_Id /= No_Language_Index loop
+ if Lang_Id.Config.Kind = Unit_Based then
+ if Dot_Replacement /= No_File then
+ Lang_Id.Config.Naming_Data.Dot_Replacement :=
+ Dot_Replacement;
+ end if;
- Pid := Data.Tree.Projects;
- ALI_Project_Loop : loop
- exit ALI_Project_Loop when Pid = null;
+ if Casing_Defined then
+ Lang_Id.Config.Naming_Data.Casing := Casing;
+ end if;
+ end if;
- if Pid.Project /= Project then
- Dirs_Id := Pid.Project.Source_Dirs;
+ Lang_Id := Lang_Id.Next;
+ end loop;
+ end if;
- ALI_Dir_Loop :
- while Dirs_Id /= Nil_String loop
- Dir_Elem :=
- Shared.String_Elements.Table (Dirs_Id);
- Dirs_Id := Dir_Elem.Next;
+ -- Next, get the spec and body suffixes
- if Project.Library_ALI_Dir.Name =
- Path_Name_Type (Dir_Elem.Value)
- then
- Err_Vars.Error_Msg_File_1 :=
- File_Name_Type (Dir_Elem.Value);
- Err_Vars.Error_Msg_Name_1 :=
- Pid.Project.Name;
+ Lang_Id := Project.Languages;
+ while Lang_Id /= No_Language_Index loop
+ Lang := Lang_Id.Name;
- Error_Msg
- (Data.Flags,
- "library 'A'L'I directory cannot " &
- "be the same as source directory " &
- "{ of project %%",
- Lib_ALI_Dir.Location, Project);
- OK := False;
- exit ALI_Project_Loop;
- end if;
- end loop ALI_Dir_Loop;
- end if;
- Pid := Pid.Next;
- end loop ALI_Project_Loop;
- end if;
+ -- Spec_Suffix
- if not OK then
- Project.Library_ALI_Dir := No_Path_Information;
+ Suffix := Value_Of
+ (Name => Lang,
+ Attribute_Or_Array_Name => Name_Spec_Suffix,
+ In_Package => Naming_Id,
+ Shared => Shared);
- elsif Current_Verbosity = High then
+ if Suffix = Nil_Variable_Value then
+ Suffix := Value_Of
+ (Name => Lang,
+ Attribute_Or_Array_Name => Name_Specification_Suffix,
+ In_Package => Naming_Id,
+ Shared => Shared);
+ end if;
- -- Display Library ALI directory in high verbosity
+ if Suffix /= Nil_Variable_Value
+ and then Suffix.Value /= No_Name
+ then
+ Lang_Id.Config.Naming_Data.Spec_Suffix :=
+ File_Name_Type (Suffix.Value);
- Write_Attr
- ("Library ALI dir",
- Get_Name_String
- (Project.Library_ALI_Dir.Display_Name));
- end if;
- end;
- end if;
- end if;
+ Check_Illegal_Suffix
+ (Project,
+ Lang_Id.Config.Naming_Data.Spec_Suffix,
+ Lang_Id.Config.Naming_Data.Dot_Replacement,
+ "Spec_Suffix", Suffix.Location, Data);
+
+ Write_Attr
+ ("Spec_Suffix",
+ Get_Name_String (Lang_Id.Config.Naming_Data.Spec_Suffix));
end if;
- pragma Assert (Lib_Version.Kind = Single);
+ -- Body_Suffix
- if Lib_Version.Value = Empty_String then
- Debug_Output ("No library version specified");
+ Suffix :=
+ Value_Of
+ (Name => Lang,
+ Attribute_Or_Array_Name => Name_Body_Suffix,
+ In_Package => Naming_Id,
+ Shared => Shared);
- else
- Project.Lib_Internal_Name := Lib_Version.Value;
+ if Suffix = Nil_Variable_Value then
+ Suffix :=
+ Value_Of
+ (Name => Lang,
+ Attribute_Or_Array_Name => Name_Implementation_Suffix,
+ In_Package => Naming_Id,
+ Shared => Shared);
end if;
- pragma Assert (The_Lib_Kind.Kind = Single);
-
- if The_Lib_Kind.Value = Empty_String then
- Debug_Output ("No library kind specified");
+ if Suffix /= Nil_Variable_Value
+ and then Suffix.Value /= No_Name
+ then
+ Lang_Id.Config.Naming_Data.Body_Suffix :=
+ File_Name_Type (Suffix.Value);
- else
- Get_Name_String (The_Lib_Kind.Value);
+ -- The default value of separate suffix should be the same as
+ -- the body suffix, so we need to compute that first.
- declare
- Kind_Name : constant String :=
- To_Lower (Name_Buffer (1 .. Name_Len));
+ if Separate_Suffix = No_File then
+ Lang_Id.Config.Naming_Data.Separate_Suffix :=
+ Lang_Id.Config.Naming_Data.Body_Suffix;
+ Write_Attr
+ ("Sep_Suffix",
+ Get_Name_String
+ (Lang_Id.Config.Naming_Data.Separate_Suffix));
+ else
+ Lang_Id.Config.Naming_Data.Separate_Suffix :=
+ Separate_Suffix;
+ end if;
- OK : Boolean := True;
+ Check_Illegal_Suffix
+ (Project,
+ Lang_Id.Config.Naming_Data.Body_Suffix,
+ Lang_Id.Config.Naming_Data.Dot_Replacement,
+ "Body_Suffix", Suffix.Location, Data);
- begin
- if Kind_Name = "static" then
- Project.Library_Kind := Static;
+ Write_Attr
+ ("Body_Suffix",
+ Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix));
- elsif Kind_Name = "dynamic" then
- Project.Library_Kind := Dynamic;
+ elsif Separate_Suffix /= No_File then
+ Lang_Id.Config.Naming_Data.Separate_Suffix := Separate_Suffix;
+ end if;
- elsif Kind_Name = "relocatable" then
- Project.Library_Kind := Relocatable;
+ -- Spec_Suffix cannot be equal to Body_Suffix or Separate_Suffix,
+ -- since that would cause a clear ambiguity. Note that we do allow
+ -- a Spec_Suffix to have the same termination as one of these,
+ -- which causes a potential ambiguity, but we resolve that by
+ -- matching the longest possible suffix.
- else
- Error_Msg
- (Data.Flags,
- "illegal value for Library_Kind",
- The_Lib_Kind.Location, Project);
- OK := False;
- end if;
+ if Lang_Id.Config.Naming_Data.Spec_Suffix /= No_File
+ and then Lang_Id.Config.Naming_Data.Spec_Suffix =
+ Lang_Id.Config.Naming_Data.Body_Suffix
+ then
+ Error_Msg
+ (Data.Flags,
+ "Body_Suffix ("""
+ & Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix)
+ & """) cannot be the same as Spec_Suffix.",
+ Ada_Body_Suffix_Loc, Project);
+ end if;
- if Current_Verbosity = High and then OK then
- Write_Attr ("Library kind", Kind_Name);
- end if;
+ if Lang_Id.Config.Naming_Data.Body_Suffix /=
+ Lang_Id.Config.Naming_Data.Separate_Suffix
+ and then Lang_Id.Config.Naming_Data.Spec_Suffix =
+ Lang_Id.Config.Naming_Data.Separate_Suffix
+ then
+ Error_Msg
+ (Data.Flags,
+ "Separate_Suffix ("""
+ & Get_Name_String
+ (Lang_Id.Config.Naming_Data.Separate_Suffix)
+ & """) cannot be the same as Spec_Suffix.",
+ Sep_Suffix_Loc, Project);
+ end if;
- if Project.Library_Kind /= Static then
- if Support_For_Libraries = Prj.Static_Only then
- Error_Msg
- (Data.Flags,
- "only static libraries are supported " &
- "on this platform",
- The_Lib_Kind.Location, Project);
- Project.Library := False;
+ Lang_Id := Lang_Id.Next;
+ end loop;
- else
- -- Check if (obsolescent) attribute Library_GCC or
- -- Linker'Driver is declared.
+ -- Get the naming exceptions for all languages, but not for virtual
+ -- projects.
- if Lib_GCC.Value /= Empty_String then
- Error_Msg
- (Data.Flags,
- "?Library_'G'C'C is an obsolescent attribute, " &
- "use Linker''Driver instead",
- Lib_GCC.Location, Project);
- Project.Config.Shared_Lib_Driver :=
- File_Name_Type (Lib_GCC.Value);
+ 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);
- else
- declare
- Linker : constant Package_Id :=
- Value_Of
- (Name_Linker,
- Project.Decl.Packages,
- Shared);
- Driver : constant Variable_Value :=
- Value_Of
- (Name => No_Name,
- Attribute_Or_Array_Name =>
- Name_Driver,
- In_Package => Linker,
- Shared => Shared);
+ when Unit_Based =>
+ Process_Exceptions_Unit_Based (Lang_Id, Kind);
+ end case;
- begin
- if Driver /= Nil_Variable_Value
- and then Driver.Value /= Empty_String
- then
- Project.Config.Shared_Lib_Driver :=
- File_Name_Type (Driver.Value);
- end if;
- end;
- end if;
- end if;
- end if;
- end;
- end if;
+ Lang_Id := Lang_Id.Next;
+ end loop;
+ end loop;
+ end if;
+ end Check_Naming;
- if Project.Library then
- Debug_Output ("This is a library project file");
+ ----------------------------
+ -- Initialize_Naming_Data --
+ ----------------------------
- Check_Library (Project.Extends, Extends => True);
+ procedure Initialize_Naming_Data is
+ Specs : Array_Element_Id :=
+ Util.Value_Of
+ (Name_Spec_Suffix,
+ Naming.Decl.Arrays,
+ Shared);
- Imported_Project_List := Project.Imported_Projects;
- while Imported_Project_List /= null loop
- Check_Library
- (Imported_Project_List.Project,
- Extends => False);
- Imported_Project_List := Imported_Project_List.Next;
- end loop;
- end if;
+ Impls : Array_Element_Id :=
+ Util.Value_Of
+ (Name_Body_Suffix,
+ Naming.Decl.Arrays,
+ Shared);
- end if;
- end if;
+ Lang : Language_Ptr;
+ Lang_Name : Name_Id;
+ Value : Variable_Value;
+ Extended : Project_Id;
- -- Check if Linker'Switches or Linker'Default_Switches are declared.
- -- Warn if they are declared, as it is a common error to think that
- -- library are "linked" with Linker switches.
+ begin
+ -- At this stage, the project already contains the default extensions
+ -- for the various languages. We now merge those suffixes read in the
+ -- user project, and they override the default.
- if Project.Library then
- declare
- Linker_Package_Id : constant Package_Id :=
- Util.Value_Of
- (Name_Linker,
- Project.Decl.Packages, Shared);
- Linker_Package : Package_Element;
- Switches : Array_Element_Id := No_Array_Element;
+ while Specs /= No_Array_Element loop
+ Lang_Name := Shared.Array_Elements.Table (Specs).Index;
+ Lang :=
+ Get_Language_From_Name
+ (Project, Name => Get_Name_String (Lang_Name));
- begin
- if Linker_Package_Id /= No_Package then
- Linker_Package := Shared.Packages.Table (Linker_Package_Id);
+ -- An extending project inherits its parent projects' languages
+ -- so if needed we should create entries for those languages
- Switches :=
- Value_Of
- (Name => Name_Switches,
- In_Arrays => Linker_Package.Decl.Arrays,
- Shared => Shared);
+ if Lang = null then
+ Extended := Project.Extends;
+ while Extended /= null loop
+ Lang := Get_Language_From_Name
+ (Extended, Name => Get_Name_String (Lang_Name));
+ exit when Lang /= null;
- if Switches = No_Array_Element then
- Switches :=
- Value_Of
- (Name => Name_Default_Switches,
- In_Arrays => Linker_Package.Decl.Arrays,
- Shared => Shared);
- end if;
+ Extended := Extended.Extends;
+ end loop;
- if Switches /= No_Array_Element then
- Error_Msg
- (Data.Flags,
- "?Linker switches not taken into account in library " &
- "projects",
- No_Location, Project);
+ if Lang /= null then
+ Lang := new Language_Data'(Lang.all);
+ Lang.First_Source := null;
+ Lang.Next := Project.Languages;
+ Project.Languages := Lang;
end if;
end if;
- end;
- end if;
- if Project.Extends /= No_Project and then Project.Extends.Library then
+ -- If language was not found in project or the projects it extends
- -- Remove the library name from Lib_Data_Table
+ if Lang = null then
+ Debug_Output
+ ("ignoring spec naming data (lang. not in project): ",
+ Lang_Name);
- for J in 1 .. Lib_Data_Table.Last loop
- if Lib_Data_Table.Table (J).Proj = Project.Extends then
- Lib_Data_Table.Table (J) :=
- Lib_Data_Table.Table (Lib_Data_Table.Last);
- Lib_Data_Table.Set_Last (Lib_Data_Table.Last - 1);
- exit;
+ else
+ Value := Shared.Array_Elements.Table (Specs).Value;
+
+ if Value.Kind = Single then
+ Lang.Config.Naming_Data.Spec_Suffix :=
+ Canonical_Case_File_Name (Value.Value);
+ end if;
end if;
+
+ Specs := Shared.Array_Elements.Table (Specs).Next;
end loop;
- end if;
- if Project.Library and then not Lib_Name.Default then
+ while Impls /= No_Array_Element loop
+ Lang_Name := Shared.Array_Elements.Table (Impls).Index;
+ Lang :=
+ Get_Language_From_Name
+ (Project, Name => Get_Name_String (Lang_Name));
- -- Check if the same library name is used in an other library project
+ if Lang = null then
+ Debug_Output
+ ("ignoring impl naming data (lang. not in project): ",
+ Lang_Name);
+ else
+ Value := Shared.Array_Elements.Table (Impls).Value;
- for J in 1 .. Lib_Data_Table.Last loop
- if Lib_Data_Table.Table (J).Name = Project.Library_Name then
- Error_Msg_Name_1 := Lib_Data_Table.Table (J).Proj.Name;
- Error_Msg
- (Data.Flags,
- "Library name cannot be the same as in project %%",
- Lib_Name.Location, Project);
- Project.Library := False;
- exit;
+ if Lang.Name = Name_Ada then
+ Ada_Body_Suffix_Loc := Value.Location;
+ end if;
+
+ if Value.Kind = Single then
+ Lang.Config.Naming_Data.Body_Suffix :=
+ Canonical_Case_File_Name (Value.Value);
+ end if;
end if;
+
+ Impls := Shared.Array_Elements.Table (Impls).Next;
end loop;
- end if;
+ end Initialize_Naming_Data;
- if Project.Library then
+ -- Start of processing for Check_Naming_Schemes
- -- Record the library name
+ begin
+ -- No Naming package or parsing a configuration file? nothing to do
- Lib_Data_Table.Append
- ((Name => Project.Library_Name, Proj => Project));
+ if Naming_Id /= No_Package
+ and then Project.Qualifier /= Configuration
+ then
+ Naming := Shared.Packages.Table (Naming_Id);
+ Debug_Increase_Indent ("checking package Naming for ", Project.Name);
+ Initialize_Naming_Data;
+ Check_Naming;
+ Debug_Decrease_Indent ("done checking package naming");
end if;
- end Check_Library_Attributes;
+ end Check_Package_Naming;
---------------------------------
-- Check_Programming_Languages --
Project.Languages := Lang;
Lang.Name := Name;
Lang.Display_Name := Display_Name;
-
- if Name = Name_Ada then
- Lang.Config.Kind := Unit_Based;
- Lang.Config.Dependency_Kind := ALI_File;
- else
- Lang.Config.Kind := File_Based;
- end if;
end Add_Language;
-- Start of processing for Check_Programming_Languages
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,
end if;
end if;
- -- If both the reference symbol file and the symbol file are
- -- defined, then check that they are not the same file.
+ -- If both the reference symbol file and the symbol file are
+ -- defined, then check that they are not the same file.
+
+ if Project.Symbol_Data.Symbol_File /= No_Path then
+ Get_Name_String (Project.Symbol_Data.Symbol_File);
+
+ if Name_Len > 0 then
+ declare
+ -- We do not need to pass a Directory to
+ -- Normalize_Pathname, since the path_information
+ -- already contains absolute information.
+
+ Symb_Path : constant String :=
+ Normalize_Pathname
+ (Get_Name_String
+ (Project.Object_Directory.Name) &
+ Name_Buffer (1 .. Name_Len),
+ Directory => "/",
+ Resolve_Links =>
+ Opt.Follow_Links_For_Files);
+ Ref_Path : constant String :=
+ Normalize_Pathname
+ (Get_Name_String
+ (Project.Symbol_Data.Reference),
+ Directory => "/",
+ Resolve_Links =>
+ Opt.Follow_Links_For_Files);
+ begin
+ if Symb_Path = Ref_Path then
+ Error_Msg
+ (Data.Flags,
+ "library reference symbol file and library" &
+ " symbol file cannot be the same file",
+ Lib_Ref_Symbol_File.Location, Project);
+ end if;
+ end;
+ end if;
+ end if;
+ end if;
+ end if;
+ end if;
+ end Check_Stand_Alone_Library;
+
+ ---------------------
+ -- Check_Unit_Name --
+ ---------------------
+
+ procedure Check_Unit_Name (Name : String; Unit : out Name_Id) is
+ The_Name : String := Name;
+ Real_Name : Name_Id;
+ Need_Letter : Boolean := True;
+ Last_Underscore : Boolean := False;
+ OK : Boolean := The_Name'Length > 0;
+ First : Positive;
+
+ function Is_Reserved (Name : Name_Id) return Boolean;
+ function Is_Reserved (S : String) return Boolean;
+ -- Check that the given name is not an Ada 95 reserved word. The reason
+ -- for the Ada 95 here is that we do not want to exclude the case of an
+ -- Ada 95 unit called Interface (for example). In Ada 2005, such a unit
+ -- name would be rejected anyway by the compiler. That means there is no
+ -- requirement that the project file parser reject this.
+
+ -----------------
+ -- Is_Reserved --
+ -----------------
+
+ function Is_Reserved (S : String) return Boolean is
+ begin
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer (S);
+ return Is_Reserved (Name_Find);
+ end Is_Reserved;
+
+ -----------------
+ -- Is_Reserved --
+ -----------------
+
+ function Is_Reserved (Name : Name_Id) return Boolean is
+ begin
+ if Get_Name_Table_Byte (Name) /= 0
+ 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;
+ Debug_Output ("Ada reserved word: ", Name);
+ return True;
+
+ else
+ return False;
+ end if;
+ end Is_Reserved;
+
+ -- Start of processing for Check_Unit_Name
+
+ begin
+ To_Lower (The_Name);
+
+ Name_Len := The_Name'Length;
+ Name_Buffer (1 .. Name_Len) := The_Name;
+
+ Real_Name := Name_Find;
+
+ if Is_Reserved (Real_Name) then
+ return;
+ end if;
+
+ First := The_Name'First;
+
+ for Index in The_Name'Range loop
+ if Need_Letter then
+
+ -- We need a letter (at the beginning, and following a dot),
+ -- but we don't have one.
+
+ if Is_Letter (The_Name (Index)) then
+ Need_Letter := False;
+
+ else
+ OK := False;
+
+ if Current_Verbosity = High then
+ Debug_Indent;
+ Write_Int (Types.Int (Index));
+ Write_Str (": '");
+ Write_Char (The_Name (Index));
+ Write_Line ("' is not a letter.");
+ end if;
+
+ exit;
+ end if;
+
+ elsif Last_Underscore
+ and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
+ then
+ -- Two underscores are illegal, and a dot cannot follow
+ -- an underscore.
+
+ OK := False;
+
+ if Current_Verbosity = High then
+ Debug_Indent;
+ Write_Int (Types.Int (Index));
+ Write_Str (": '");
+ Write_Char (The_Name (Index));
+ Write_Line ("' is illegal here.");
+ end if;
+
+ exit;
+
+ elsif The_Name (Index) = '.' then
+
+ -- First, check if the name before the dot is not a reserved word
+
+ if Is_Reserved (The_Name (First .. Index - 1)) then
+ return;
+ end if;
+
+ First := Index + 1;
+
+ -- We need a letter after a dot
+
+ Need_Letter := True;
+
+ elsif The_Name (Index) = '_' then
+ Last_Underscore := True;
+
+ else
+ -- We need an letter or a digit
- if Project.Symbol_Data.Symbol_File /= No_Path then
- Get_Name_String (Project.Symbol_Data.Symbol_File);
+ Last_Underscore := False;
- if Name_Len > 0 then
- declare
- -- We do not need to pass a Directory to
- -- Normalize_Pathname, since the path_information
- -- already contains absolute information.
+ if not Is_Alphanumeric (The_Name (Index)) then
+ OK := False;
- Symb_Path : constant String :=
- Normalize_Pathname
- (Get_Name_String
- (Project.Object_Directory.Name) &
- Name_Buffer (1 .. Name_Len),
- Directory => "/",
- Resolve_Links =>
- Opt.Follow_Links_For_Files);
- Ref_Path : constant String :=
- Normalize_Pathname
- (Get_Name_String
- (Project.Symbol_Data.Reference),
- Directory => "/",
- Resolve_Links =>
- Opt.Follow_Links_For_Files);
- begin
- if Symb_Path = Ref_Path then
- Error_Msg
- (Data.Flags,
- "library reference symbol file and library" &
- " symbol file cannot be the same file",
- Lib_Ref_Symbol_File.Location, Project);
- end if;
- end;
- end if;
+ if Current_Verbosity = High then
+ Debug_Indent;
+ Write_Int (Types.Int (Index));
+ Write_Str (": '");
+ Write_Char (The_Name (Index));
+ Write_Line ("' is not alphanumeric.");
end if;
+
+ exit;
end if;
end if;
+ end loop;
+
+ -- Cannot end with an underscore or a dot
+
+ 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))
+ then
+ return;
+ end if;
+
+ Unit := Real_Name;
+
+ else
+ -- Signal a problem with No_Name
+
+ Unit := No_Name;
end if;
- end Check_Stand_Alone_Library;
+ end Check_Unit_Name;
----------------------------
-- Compute_Directory_Last --
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
-- The directory is in the list if List is not Nil_String
if not Remove_Source_Dirs and then List = Nil_String then
- Debug_Output ("Adding source dir=", Name_Id (Path.Display_Name));
+ Debug_Output ("adding source dir=", Name_Id (Path.Display_Name));
String_Element_Table.Increment_Last (Shared.String_Elements);
Element :=
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
begin
- Debug_Output ("Starting to look for directories");
+ Debug_Output ("starting to look for directories");
-- Set the object directory to its default which may be nil, if there
-- is no sources in the project.
"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
Must_Exist => False,
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 not Dir_Exists and then not Project.Externally_Built then
+ 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
if Current_Verbosity = High then
if Project.Object_Directory = No_Path_Information then
- Debug_Output ("No object directory");
+ Debug_Output ("no object directory");
else
Write_Attr
("Object directory",
-- We set the object directory to its default
- Project.Exec_Directory := Project.Object_Directory;
+ Project.Exec_Directory := Project.Object_Directory;
if Exec_Dir.Value /= Empty_String then
Get_Name_String (Exec_Dir.Value);
"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;
if Current_Verbosity = High then
if Project.Exec_Directory = No_Path_Information then
- Debug_Output ("No exec directory");
+ Debug_Output ("no exec directory");
else
Debug_Output
- ("Exec directory: ",
+ ("exec directory: ",
Name_Id (Project.Exec_Directory.Display_Name));
end if;
end if;
-- Look for the source directories
- Debug_Output ("Starting to look for source directories");
+ Debug_Output ("starting to look for source directories");
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;
Remove_Source_Dirs := False;
Add_To_Or_Remove_From_Source_Dirs
- (Path => (Name => Project.Directory.Name,
- Display_Name => Project.Directory.Display_Name),
- Rank => 1);
+ (Path => (Name => Project.Directory.Name,
+ Display_Name => Project.Directory.Display_Name),
+ Rank => 1);
else
Remove_Source_Dirs := False;
Find_Source_Dirs
- (Project => Project,
- Data => Data,
- Patterns => Source_Dirs.Values,
- Ignore => Ignore_Source_Sub_Dirs.Values,
- Search_For => Search_Directories,
- Resolve_Links => Opt.Follow_Links_For_Dirs);
+ (Project => Project,
+ Data => Data,
+ Patterns => Source_Dirs.Values,
+ Ignore => Ignore_Source_Sub_Dirs.Values,
+ Search_For => Search_Directories,
+ Resolve_Links => Opt.Follow_Links_For_Dirs);
if Project.Source_Dirs = Nil_String
and then Project.Qualifier = Standard
then
Remove_Source_Dirs := True;
Find_Source_Dirs
- (Project => Project,
- Data => Data,
- Patterns => Excluded_Source_Dirs.Values,
- Ignore => Nil_String,
- Search_For => Search_Directories,
- Resolve_Links => Opt.Follow_Links_For_Dirs);
+ (Project => Project,
+ Data => Data,
+ Patterns => Excluded_Source_Dirs.Values,
+ Ignore => Nil_String,
+ Search_For => Search_Directories,
+ Resolve_Links => Opt.Follow_Links_For_Dirs);
end if;
- Debug_Output ("Putting source directories in canonical cases");
+ Debug_Output ("putting source directories in canonical cases");
declare
Current : String_List_Id := Project.Source_Dirs;
begin
if Current_Verbosity = High then
- Debug_Output ("Opening """ & Path & '"');
+ Debug_Output ("opening """ & Path & '"');
end if;
-- Open the file
-- 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;
end if;
if Naming.Dot_Replacement = No_File then
- Debug_Output ("No dot_replacement specified");
+ Debug_Output ("no dot_replacement specified");
return;
end if;
if Is_Letter (Filename (J))
and then not Is_Lower (Filename (J))
then
- Debug_Output ("Invalid casing");
+ Debug_Output ("invalid casing");
return;
end if;
end loop;
if Is_Letter (Filename (J))
and then not Is_Upper (Filename (J))
then
- Debug_Output ("Invalid casing");
+ Debug_Output ("invalid casing");
return;
end if;
end loop;
if Dot_Repl /= "." then
for Index in Filename'First .. Last loop
if Filename (Index) = '.' then
- Debug_Output ("Invalid name, contains dot");
+ Debug_Output ("invalid name, contains dot");
return;
end if;
end loop;
-- 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,
-- Name_Buffer contains the name of the unit in lower-cases. Check
-- that this is a valid unit name
- Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
+ Check_Unit_Name (Name_Buffer (1 .. Name_Len), Unit);
-- If there is a naming exception for the same unit, the file is not
-- a source for the unit.
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,
declare
Source_File_Path_Name : constant String :=
- Path_Name_Of
- (File_Name_Type (Source_List_File.Value),
- Project.Project.Directory.Display_Name);
+ Path_Name_Of
+ (File_Name_Type
+ (Source_List_File.Value),
+ Project.Project.
+ Directory.Display_Name);
begin
Has_Explicit_Sources := True;
Source := Prj.Element (Iter);
exit Source_Loop when Source = No_Source;
- if Source.Naming_Exception then
+ if Source.Naming_Exception /= No then
NL := Source_Names_Htable.Get
(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,
No_Name_Location);
Remove_Source (Data.Tree, Source, No_Source);
- Error_Msg_Name_1 := Name_Id (Source.File);
- Error_Msg
- (Data.Flags,
- "? unknown source file %%",
- NL.Location,
- Project.Project);
+ if Source.Naming_Exception = Yes then
+ Error_Msg_Name_1 := Name_Id (Source.File);
+ Error_Msg
+ (Data.Flags,
+ "? unknown source file %%",
+ NL.Location,
+ Project.Project);
+ end if;
Again := True;
exit Source_Loop;
-- the same file has received the full path, so we need to
-- propagate it.
- if Source.Naming_Exception
- and then Source.Path = No_Path_Information
- then
- if Source.Unit /= No_Unit_Index then
- Found := False;
+ if Source.Path = No_Path_Information then
+ if Source.Naming_Exception = Yes then
+ if Source.Unit /= No_Unit_Index then
+ Found := False;
- if Source.Index /= 0 then -- Only multi-unit files
- declare
- S : Source_Id :=
- Source_Files_Htable.Get
- (Data.Tree.Source_Files_HT, Source.File);
- begin
- while S /= null loop
- if S.Path /= No_Path_Information then
- Source.Path := S.Path;
- Found := True;
+ if Source.Index /= 0 then -- Only multi-unit files
+ declare
+ S : Source_Id :=
+ Source_Files_Htable.Get
+ (Data.Tree.Source_Files_HT, Source.File);
- if Current_Verbosity = High then
- Debug_Output
- ("Setting full path for "
- & Get_Name_String (Source.File)
- & " at" & Source.Index'Img
- & " to "
- & Get_Name_String (Source.Path.Name));
+ begin
+ while S /= null loop
+ if S.Path /= No_Path_Information then
+ Source.Path := S.Path;
+ Found := True;
+
+ if Current_Verbosity = High then
+ Debug_Output
+ ("setting full path for "
+ & Get_Name_String (Source.File)
+ & " at" & Source.Index'Img
+ & " to "
+ & Get_Name_String (Source.Path.Name));
+ end if;
+
+ exit;
end if;
- exit;
- end if;
+ S := S.Next_With_File_Name;
+ end loop;
+ end;
+ end if;
- S := S.Next_With_File_Name;
- end loop;
- end;
+ if not Found then
+ Error_Msg_Name_1 := Name_Id (Source.Display_File);
+ Error_Msg_Name_2 := Source.Unit.Name;
+ Error_Or_Warning
+ (Data.Flags, Data.Flags.Missing_Source_Files,
+ "\source file %% for unit %% not found",
+ No_Location, Project.Project);
+ end if;
end if;
- if not Found then
- Error_Msg_Name_1 := Name_Id (Source.Display_File);
- Error_Msg_Name_2 := Source.Unit.Name;
- Error_Or_Warning
- (Data.Flags, Data.Flags.Missing_Source_Files,
- "source file %% for unit %% not found",
- No_Location, Project.Project);
+ if Source.Path = No_Path_Information then
+ Remove_Source (Data.Tree, Source, No_Source);
end if;
- end if;
- if Source.Path = No_Path_Information then
+ elsif Source.Naming_Exception = Inherited then
Remove_Source (Data.Tree, Source, No_Source);
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;
Language := Tmp_Lang;
Debug_Output
- ("Implementation of language ", Display_Language_Name);
+ ("implementation of language ", Display_Language_Name);
elsif Suffix_Matches (Filename, Config.Naming_Data.Spec_Suffix) then
Debug_Output
- ("Header of language ", Display_Language_Name);
+ ("header of language ", Display_Language_Name);
if Header_File then
Alternate_Languages := new Language_List_Element'
while Tmp_Lang /= No_Language_Index loop
if Current_Verbosity = High then
Debug_Output
- ("Testing language "
+ ("testing language "
& Get_Name_String (Tmp_Lang.Name)
& " Header_File=" & Header_File'Img);
end if;
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;
-- If we had another file referencing the same unit (for instance it
-- was in an extended project), that source file is in fact invisible
-- from now on, and in particular doesn't belong to the same unit.
+ -- If the source is an inherited naming exception, then it may not
+ -- really exist: the source potentially replaced is left untouched.
if Source.Unit.File_Names (Source.Kind) /= Source then
Source.Unit.File_Names (Source.Kind).Unit := No_Unit_Index;
Source.Kind := Kind;
- if Current_Verbosity = High
- and then Source.File /= No_File
- then
- Debug_Output ("Override kind for "
+ 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;
begin
if Current_Verbosity = High then
Debug_Increase_Indent
- ("Checking file (rank=" & Source_Dir_Rank'Img & ")",
+ ("checking file (rank=" & Source_Dir_Rank'Img & ")",
Name_Id (Display_Path));
end if;
-- 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,
Override_Kind (Name_Loc.Source, Sep);
end if;
end if;
+
+ -- If this is an inherited naming exception, make sure that
+ -- the naming exception it replaces is no longer a source.
+
+ if Name_Loc.Source.Naming_Exception = Inherited then
+ declare
+ 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);
+ Src := Prj.Element (Iter);
+ while Src /= No_Source loop
+ if Src.File = Name_Loc.Source.File then
+ Src.Replaced_By := Name_Loc.Source;
+ exit;
+ end if;
+
+ Next (Iter);
+ Src := Prj.Element (Iter);
+ end loop;
+
+ Proj := Proj.Extends;
+ end loop;
+ end;
+
+ if Name_Loc.Source.Unit /= No_Unit_Index then
+ if Name_Loc.Source.Kind = Spec then
+ Name_Loc.Source.Unit.File_Names (Spec) :=
+ Name_Loc.Source;
+
+ elsif Name_Loc.Source.Kind = Impl then
+ Name_Loc.Source.Unit.File_Names (Impl) :=
+ Name_Loc.Source;
+ end if;
+
+ Units_Htable.Set
+ (Data.Tree.Units_HT,
+ Name_Loc.Source.Unit.Name,
+ Name_Loc.Source.Unit);
+ end if;
+ 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
-- several times, and to avoid cycles that may be introduced by symbolic
-- links.
- File_Pattern : GNAT.Regexp.Regexp;
- -- Pattern to use when matching file names.
+ File_Pattern : GNAT.Regexp.Regexp;
+ -- Pattern to use when matching file names
Visited : Recursive_Dirs.Instance;
(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));
+ Debug_Output ("looking for subdirs of ", Name_Id (Path.Display_Name));
if Recursive_Dirs.Get (Visited, Path.Name) then
return Success;
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.
end if;
end if;
- Debug_Decrease_Indent ("Done Find_Pattern");
+ Debug_Decrease_Indent ("done Find_Pattern");
end Find_Pattern;
-- Local variables
Display_File_Name : File_Name_Type;
begin
- Debug_Increase_Indent ("Looking for sources of", Project.Project.Name);
+ Debug_Increase_Indent ("looking for sources of", Project.Project.Name);
-- 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
(Project.Excluded, File_Name, FF);
Debug_Output
- ("Excluded source ",
+ ("excluded source ",
Name_Id (Display_File_Name));
-- Will mark the file as removed, but we
else
if Current_Verbosity = High then
- Debug_Output ("Ignore " & Name (1 .. Last));
+ Debug_Output ("ignore " & Name (1 .. Last));
end if;
end if;
end loop;
Src_Dir_Rank := Num_Nod.Next;
end loop;
- Debug_Decrease_Indent ("end Looking for sources.");
+ Debug_Decrease_Indent ("end looking for sources.");
end Search_Directories;
----------------------------
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;
Debug_Output
- ("Naming exception: adding source file to source_Names: ",
+ ("naming exception: adding source file to source_Names: ",
Name_Id (Source.File));
Source_Names_Htable.Set
if Source.Unit /= No_Unit_Index then
declare
Unit_Except : Unit_Exception :=
- Unit_Exceptions_Htable.Get
- (Project.Unit_Exceptions, Source.Unit.Name);
+ Unit_Exceptions_Htable.Get
+ (Project.Unit_Exceptions, Source.Unit.Name);
begin
Unit_Except.Name := Source.Unit.Name;
procedure Check_Missing_Sources is
Extending : constant Boolean :=
- Project.Project.Extends /= No_Project;
+ Project.Project.Extends /= No_Project;
Language : Language_Ptr;
Source : Source_Id;
Alt_Lang : Language_List;
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);
-- the same file it is expected that it has the same object)
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;
- Write_Str ("Removing file ");
+ Write_Str ("removing file ");
Write_Line
(Get_Name_String (Excluded.File)
& " " & Get_Name_String (Source.Project.Name));
Src : Source_Info;
Id : Source_Id;
Lang_Id : Language_Ptr;
+
begin
Initialize (Iter, Project.Project.Name);
Id.Project := Project.Project;
Lang_Id := Project.Project.Languages;
- while Lang_Id /= No_Language_Index and then
- Lang_Id.Name /= Src.Language
+ while Lang_Id /= No_Language_Index
+ and then Lang_Id.Name /= Src.Language
loop
Lang_Id := Lang_Id.Next;
end loop;
" in source info file");
end if;
- Id.Language := Lang_Id;
- Id.Kind := Src.Kind;
- Id.Index := Src.Index;
+ Id.Language := Lang_Id;
+ Id.Kind := Src.Kind;
+ Id.Index := Src.Index;
Id.Path :=
(Path_Name_Type (Src.Display_Path_Name),
Name_Len := 0;
Add_Str_To_Name_Buffer
- (Ada.Directories.Simple_Name
- (Get_Name_String (Src.Path_Name)));
+ (Directories.Simple_Name (Get_Name_String (Src.Path_Name)));
Id.File := Name_Find;
Id.Next_With_File_Name :=
Name_Len := 0;
Add_Str_To_Name_Buffer
- (Ada.Directories.Simple_Name
+ (Directories.Simple_Name
(Get_Name_String (Src.Display_Path_Name)));
Id.Display_File := Name_Find;
- Id.Dep_Name := Dependency_Name
- (Id.File, Id.Language.Config.Dependency_Kind);
- Id.Naming_Exception := Src.Naming_Exception;
- Id.Object := Object_Name
- (Id.File, Id.Language.Config.Object_File_Suffix);
- Id.Switches := Switches_Name (Id.File);
+ Id.Dep_Name :=
+ Dependency_Name (Id.File, Id.Language.Config.Dependency_Kind);
+ Id.Naming_Exception := Src.Naming_Exception;
+ Id.Object :=
+ Object_Name (Id.File, Id.Language.Config.Object_File_Suffix);
+ Id.Switches := Switches_Name (Id.File);
-- Add the source id to the Unit_Sources_HT hash table, if the
-- 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);
The_Directory : constant String := Get_Name_String (Directory);
begin
- Debug_Output ("Path_Name_Of file_name=", Name_Id (File_Name));
+ Debug_Output ("Path_Name_Of file name=", Name_Id (File_Name));
Debug_Output ("Path_Name_Of directory=", Name_Id (Directory));
Get_Name_String (File_Name);
Result :=
begin
if Current_Verbosity = High then
Debug_Indent;
- Write_Str ("Removing source ");
+ Write_Str ("removing source ");
Write_Str (Get_Name_String (Id.File));
if Id.Index /= 0 then
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;
begin
if Project.Source_Dirs = Nil_String then
- Debug_Output ("No source dirs");
+ Debug_Output ("no Source_Dirs");
else
Debug_Increase_Indent ("Source_Dirs:");
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");
+ 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