-- Copy Str into Name_Buffer, replacing Pattern with Replacement. Str is
-- converted to lower-case at the same time.
- procedure Check_Unit_Name (Name : String; Unit : out Name_Id);
- -- Check that a name is a valid 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.
Free (Project_Path_For_Aggregate);
end Process_Aggregated_Projects;
- ----------------------------
- -- Check_Abstract_Project --
- ----------------------------
-
- procedure Check_Abstract_Project
- (Project : Project_Id;
- Data : in out Tree_Processing_Data)
- is
- Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
-
- Source_Dirs : constant Variable_Value :=
- Util.Value_Of
- (Name_Source_Dirs,
- Project.Decl.Attributes, Shared);
- Source_Files : constant Variable_Value :=
- Util.Value_Of
- (Name_Source_Files,
- Project.Decl.Attributes, Shared);
- Source_List_File : constant Variable_Value :=
- Util.Value_Of
- (Name_Source_List_File,
- Project.Decl.Attributes, Shared);
- Languages : constant Variable_Value :=
- Util.Value_Of
- (Name_Languages,
- Project.Decl.Attributes, Shared);
-
- begin
- if Project.Source_Dirs /= Nil_String then
- if Source_Dirs.Values = Nil_String
- and then Source_Files.Values = Nil_String
- and then Languages.Values = Nil_String
- and then Source_List_File.Default
- then
- Project.Source_Dirs := Nil_String;
-
- else
- Error_Msg
- (Data.Flags,
- "at least one of Source_Files, Source_Dirs or Languages "
- & "must be declared empty for an abstract project",
- Project.Location, Project);
- end if;
- end if;
- end Check_Abstract_Project;
-
-----------
-- Check --
-----------
Debug_Decrease_Indent ("done check");
end Check;
- ---------------------
- -- 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 --
- -----------------
+ ----------------------------
+ -- Check_Abstract_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;
+ procedure Check_Abstract_Project
+ (Project : Project_Id;
+ Data : in out Tree_Processing_Data)
+ is
+ Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
- -----------------
- -- Is_Reserved --
- -----------------
+ Source_Dirs : constant Variable_Value :=
+ Util.Value_Of
+ (Name_Source_Dirs,
+ Project.Decl.Attributes, Shared);
+ Source_Files : constant Variable_Value :=
+ Util.Value_Of
+ (Name_Source_Files,
+ Project.Decl.Attributes, Shared);
+ Source_List_File : constant Variable_Value :=
+ Util.Value_Of
+ (Name_Source_List_File,
+ Project.Decl.Attributes, Shared);
+ Languages : constant Variable_Value :=
+ Util.Value_Of
+ (Name_Languages,
+ Project.Decl.Attributes, Shared);
- 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
+ begin
+ if Project.Source_Dirs /= Nil_String then
+ if Source_Dirs.Values = Nil_String
+ and then Source_Files.Values = Nil_String
+ and then Languages.Values = Nil_String
+ and then Source_List_File.Default
then
- Unit := No_Name;
- Debug_Output ("Ada reserved word: ", Name);
- return True;
+ Project.Source_Dirs := Nil_String;
else
- return False;
+ Error_Msg
+ (Data.Flags,
+ "at least one of Source_Files, Source_Dirs or Languages "
+ & "must be declared empty for an abstract project",
+ Project.Location, Project);
end if;
- end Is_Reserved;
+ end if;
+ end Check_Abstract_Project;
- -- Start of processing for Check_Unit_Name
+ -------------------------
+ -- Check_Configuration --
+ -------------------------
- begin
- To_Lower (The_Name);
+ procedure Check_Configuration
+ (Project : Project_Id;
+ Data : in out Tree_Processing_Data)
+ is
+ Shared : constant Shared_Project_Tree_Data_Access :=
+ Data.Tree.Shared;
- Name_Len := The_Name'Length;
- Name_Buffer (1 .. Name_Len) := The_Name;
+ Dot_Replacement : File_Name_Type := No_File;
+ Casing : Casing_Type := All_Lower_Case;
+ Separate_Suffix : File_Name_Type := No_File;
- -- Special cases of children of packages A, G, I and S on VMS
+ Lang_Index : Language_Ptr := No_Language_Index;
+ -- The index of the language data being checked
- 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;
+ Prev_Index : Language_Ptr := No_Language_Index;
+ -- The index of the previous language
- Real_Name := Name_Find;
+ procedure Process_Project_Level_Simple_Attributes;
+ -- Process the simple attributes at the project level
- if Is_Reserved (Real_Name) then
- return;
- end if;
+ procedure Process_Project_Level_Array_Attributes;
+ -- Process the associate array attributes at the project level
- First := The_Name'First;
+ procedure Process_Packages;
+ -- Read the packages of the project
- for Index in The_Name'Range loop
- if Need_Letter then
+ ----------------------
+ -- Process_Packages --
+ ----------------------
- -- We need a letter (at the beginning, and following a dot),
- -- but we don't have one.
+ procedure Process_Packages is
+ Packages : Package_Id;
+ Element : Package_Element;
- if Is_Letter (The_Name (Index)) then
- Need_Letter := False;
+ procedure Process_Binder (Arrays : Array_Id);
+ -- Process the associate array attributes of package Binder
- else
- OK := False;
+ procedure Process_Builder (Attributes : Variable_Id);
+ -- Process the simple attributes of package Builder
- 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;
+ procedure Process_Compiler (Arrays : Array_Id);
+ -- Process the associate array attributes of package Compiler
- exit;
- end if;
+ procedure Process_Naming (Attributes : Variable_Id);
+ -- Process the simple attributes of package Naming
- 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.
+ procedure Process_Naming (Arrays : Array_Id);
+ -- Process the associate array attributes of package Naming
- OK := False;
+ procedure Process_Linker (Attributes : Variable_Id);
+ -- Process the simple attributes of package Linker of a
+ -- configuration project.
- 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;
+ --------------------
+ -- Process_Binder --
+ --------------------
- exit;
+ procedure Process_Binder (Arrays : Array_Id) is
+ Current_Array_Id : Array_Id;
+ Current_Array : Array_Data;
+ Element_Id : Array_Element_Id;
+ Element : Array_Element;
- elsif The_Name (Index) = '.' then
+ begin
+ -- Process the associative array attribute of package Binder
- -- 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
-
- Last_Underscore := False;
-
- if not Is_Alphanumeric (The_Name (Index)) then
- 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 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_Unit_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
-
- Prev_Index : Language_Ptr := No_Language_Index;
- -- The index of the previous language
-
- procedure Process_Project_Level_Simple_Attributes;
- -- Process the simple attributes at the project level
-
- procedure Process_Project_Level_Array_Attributes;
- -- Process the associate array attributes at the project level
-
- procedure Process_Packages;
- -- Read the packages of the project
-
- ----------------------
- -- Process_Packages --
- ----------------------
-
- procedure Process_Packages is
- Packages : Package_Id;
- Element : Package_Element;
-
- procedure Process_Binder (Arrays : Array_Id);
- -- Process the associate array attributes of package Binder
-
- procedure Process_Builder (Attributes : Variable_Id);
- -- Process the simple attributes of package Builder
-
- procedure Process_Compiler (Arrays : Array_Id);
- -- Process the associate array attributes of package Compiler
-
- procedure Process_Naming (Attributes : Variable_Id);
- -- Process the simple attributes of package Naming
-
- procedure Process_Naming (Arrays : Array_Id);
- -- Process the associate array attributes of package Naming
-
- procedure Process_Linker (Attributes : Variable_Id);
- -- Process the simple attributes of package Linker of a
- -- configuration project.
-
- --------------------
- -- Process_Binder --
- --------------------
-
- procedure Process_Binder (Arrays : Array_Id) is
- Current_Array_Id : Array_Id;
- Current_Array : Array_Data;
- Element_Id : Array_Element_Id;
- Element : Array_Element;
-
- begin
- -- Process the associative array attribute of package Binder
-
- Current_Array_Id := Arrays;
- while Current_Array_Id /= No_Array loop
- Current_Array := Shared.Arrays.Table (Current_Array_Id);
+ Current_Array_Id := Arrays;
+ while Current_Array_Id /= No_Array loop
+ Current_Array := Shared.Arrays.Table (Current_Array_Id);
Element_Id := Current_Array.Value;
while Element_Id /= No_Array_Element loop
if Lang_Index /= No_Language_Index then
case Current_Array.Name is
- when Name_Dependency_Kind =>
- -- Attribute Dependency_Kind (<language>)
+ -- Attribute Dependency_Kind (<language>)
+ when Name_Dependency_Kind =>
Get_Name_String (Element.Value.Value);
begin
Project);
end;
- when Name_Dependency_Switches =>
-
- -- Attribute Dependency_Switches (<language>)
+ -- 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_Language_Kind =>
- -- Attribute Language_Kind (<language>)
+ -- Attribute Language_Kind (<language>)
+ when Name_Language_Kind =>
Get_Name_String (Element.Value.Value);
begin
Project);
end;
- when Name_Include_Switches =>
-
- -- 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 =>
-
- -- 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 =>
Put (Into_List =>
- Lang_Index.Config.
- Compiler_Leading_Required_Switches,
+ Lang_Index.Config.
+ Compiler_Leading_Required_Switches,
From_List => Element.Value.Values,
In_Tree => Data.Tree);
when Name_Trailing_Required_Switches =>
Put (Into_List =>
- Lang_Index.Config.
- Compiler_Trailing_Required_Switches,
+ Lang_Index.Config.
+ Compiler_Trailing_Required_Switches,
From_List => Element.Value.Values,
In_Tree => Data.Tree);
From_List => Element.Value.Values,
In_Tree => Data.Tree);
- when Name_Pic_Option =>
-
- -- 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
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_Version : constant Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Library_Version, Attributes, Shared);
- procedure Initialize_Naming_Data;
- -- Initialize internal naming data for the various languages
+ Lib_ALI_Dir : constant Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Library_Ali_Dir, Attributes, Shared);
- ------------------
- -- Check_Common --
- ------------------
+ Lib_GCC : constant Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Library_GCC, 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;
+ The_Lib_Kind : constant Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Library_Kind, Attributes, Shared);
- begin
- Sep_Suffix_Loc := No_Location;
+ Imported_Project_List : Project_List;
- if not Dot_Repl.Default then
- pragma Assert
- (Dot_Repl.Kind = Single, "Dot_Replacement is not a string");
+ Continuation : String_Access := No_Continuation_String'Access;
- if Length_Of_Name (Dot_Repl.Value) = 0 then
- Error_Msg
- (Data.Flags, "Dot_Replacement cannot be empty",
- Dot_Repl.Location, Project);
- end if;
+ Support_For_Libraries : Library_Support;
- Dot_Replacement := Canonical_Case_File_Name (Dot_Repl.Value);
- Dot_Repl_Loc := Dot_Repl.Location;
+ Library_Directory_Present : Boolean;
- declare
- Repl : constant String := Get_Name_String (Dot_Replacement);
+ procedure Check_Library (Proj : Project_Id; Extends : Boolean);
+ -- Check if an imported or extended project if also a library project
- 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_Library --
+ -------------------
- 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_Library (Proj : Project_Id; Extends : Boolean) is
+ Src_Id : Source_Id;
+ Iter : Source_Iterator;
- if Dot_Replacement /= No_File then
- Write_Attr
- ("Dot_Replacement", Get_Name_String (Dot_Replacement));
- end if;
+ begin
+ if Proj /= No_Project then
+ if not Proj.Library then
- Casing_Defined := False;
+ -- 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 not Casing_String.Default then
- pragma Assert
- (Casing_String.Kind = Single, "Casing is not a string");
+ 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;
- declare
- Casing_Image : constant String :=
- Get_Name_String (Casing_String.Value);
+ if Src_Id /= No_Source then
+ Error_Msg_Name_1 := Project.Name;
+ Error_Msg_Name_2 := Proj.Name;
- begin
- if Casing_Image'Length = 0 then
- Error_Msg
- (Data.Flags,
- "Casing cannot be an empty string",
- Casing_String.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 (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;
- Casing := Value (Casing_Image);
- Casing_Defined := True;
+ elsif Project.Library_Kind /= Static and then
+ Proj.Library_Kind = Static
+ then
+ Error_Msg_Name_1 := Project.Name;
+ Error_Msg_Name_2 := Proj.Name;
- exception
- when Constraint_Error =>
- Name_Len := Casing_Image'Length;
- Name_Buffer (1 .. Name_Len) := Casing_Image;
- Err_Vars.Error_Msg_Name_1 := Name_Find;
+ if Extends then
Error_Msg
(Data.Flags,
- "%% is not a correct Casing",
- Casing_String.Location, Project);
- end;
+ Continuation.all &
+ "shared library project %% cannot extend static " &
+ "library project %%",
+ Project.Location, Project);
+ Continuation := Continuation_String'Access;
+
+ 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;
+
+ end if;
end if;
+ end Check_Library;
- Write_Attr ("Casing", Image (Casing));
+ Dir_Exists : Boolean;
- if not Sep_Suffix.Default then
- if Length_Of_Name (Sep_Suffix.Value) = 0 then
+ -- Start of processing for Check_Library_Attributes
+
+ begin
+ Library_Directory_Present := Lib_Dir.Value /= Empty_String;
+
+ -- Special case of extending project
+
+ if Project.Extends /= No_Project then
+
+ -- 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 Project.Extends.Library then
+ if Project.Qualifier = Standard then
Error_Msg
(Data.Flags,
- "Separate_Suffix cannot be empty",
- Sep_Suffix.Location, Project);
+ "a standard project cannot extend a library project",
+ Project.Location, Project);
else
- Separate_Suffix := Canonical_Case_File_Name (Sep_Suffix.Value);
- Sep_Suffix_Loc := Sep_Suffix.Location;
+ if Lib_Name.Default then
+ Project.Library_Name := Project.Extends.Library_Name;
+ end if;
- Check_Illegal_Suffix
- (Project, Separate_Suffix,
- Dot_Replacement, "Separate_Suffix", Sep_Suffix.Location,
- Data);
+ 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);
+
+ 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;
+ end if;
+ end if;
end if;
end if;
+ end if;
- if Separate_Suffix /= No_File then
- Write_Attr
- ("Separate_Suffix", Get_Name_String (Separate_Suffix));
+ 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;
- end Check_Common;
- -----------------------------------
- -- Process_Exceptions_File_Based --
- -----------------------------------
+ else
+ -- There is no restriction on the syntax of library names
- 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;
+ Project.Library_Name := Lib_Name.Value;
+ end if;
- begin
- case Kind is
- when Impl | Sep =>
- Exceptions :=
- Value_Of
- (Name_Implementation_Exceptions,
- In_Arrays => Naming.Decl.Arrays,
- Shared => Shared);
+ if Project.Library_Name /= No_Name then
+ if Current_Verbosity = High then
+ Write_Attr ("Library name: ",
+ Get_Name_String (Project.Library_Name));
+ end if;
- 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 => True,
- 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,
- "the same file cannot be a source of two languages",
- Element.Location, Project);
-
- elsif Source.Kind /= Kind then
- Error_Msg
- (Data.Flags,
- "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;
-
- Element_Id := Element.Next;
- end loop;
- end if;
- end Process_Exceptions_File_Based;
-
- -----------------------------------
- -- Process_Exceptions_Unit_Based --
- -----------------------------------
-
- 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;
-
- 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;
+ pragma Assert (Lib_Dir.Kind = Single);
- when Spec =>
- Exceptions :=
- Value_Of
- (Name_Spec,
- In_Arrays => Naming.Decl.Arrays,
- Shared => Shared);
+ if not Library_Directory_Present then
+ Debug_Output ("no library directory");
- if Exceptions = No_Array_Element then
- Exceptions :=
- Value_Of
- (Name_Spec,
- In_Arrays => Naming.Decl.Arrays,
- Shared => Shared);
- end if;
- end case;
+ else
+ -- Find path name (unless inherited), check that it is a directory
- while Exceptions /= No_Array_Element loop
- Element := Shared.Array_Elements.Table (Exceptions);
- File_Name := Canonical_Case_File_Name (Element.Value.Value);
+ 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);
- Get_Name_String (Element.Index);
- To_Lower (Name_Buffer (1 .. Name_Len));
- Index := Element.Value.Index;
+ else
+ Dir_Exists :=
+ Is_Directory
+ (Get_Name_String (Project.Library_Dir.Display_Name));
+ end if;
- -- Check if it is a valid unit name
+ if not Dir_Exists then
- Get_Name_String (Element.Index);
- Check_Unit_Name (Name_Buffer (1 .. Name_Len), Unit);
+ -- Get the absolute name of the library directory that
+ -- does not exist, to report an error.
- if Unit = No_Name then
- Err_Vars.Error_Msg_Name_1 := Element.Index;
+ Err_Vars.Error_Msg_File_1 :=
+ File_Name_Type (Project.Library_Dir.Display_Name);
Error_Msg
(Data.Flags,
- "%% is not a valid unit name.",
- Element.Value.Location, Project);
- end if;
-
- 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;
-
- Exceptions := Element.Next;
- end loop;
- end Process_Exceptions_Unit_Based;
-
- ------------------
- -- Check_Naming --
- ------------------
+ "library directory { does not exist",
+ Lib_Dir.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;
+ elsif not Project.Externally_Built then
- begin
- Check_Common
- (Dot_Replacement => Dot_Replacement,
- Casing => Casing,
- Casing_Defined => Casing_Defined,
- Separate_Suffix => Separate_Suffix,
- Sep_Suffix_Loc => Sep_Suffix_Loc);
+ -- Library directory cannot be the same as Object directory
- -- 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 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 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
+ declare
+ OK : Boolean := True;
+ Dirs_Id : String_List_Id;
+ Dir_Elem : String_Element;
+ Pid : Project_List;
- if Casing_Defined then
- Lang_Id.Config.Naming_Data.Casing := Casing;
- end if;
- end if;
+ begin
+ -- The library directory cannot be the same as a source
+ -- directory of the current project.
- Lang_Id := Lang_Id.Next;
- end loop;
- end if;
+ Dirs_Id := Project.Source_Dirs;
+ 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_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 := Project.Languages;
- while Lang_Id /= No_Language_Index loop
- Lang := Lang_Id.Name;
+ if OK then
- -- Spec_Suffix
+ -- The library directory cannot be the same as a
+ -- source directory of another project either.
- Suffix := Value_Of
- (Name => Lang,
- Attribute_Or_Array_Name => Name_Spec_Suffix,
- In_Package => Naming_Id,
- Shared => Shared);
+ Pid := Data.Tree.Projects;
+ Project_Loop : loop
+ exit Project_Loop when Pid = null;
- 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;
+ if Pid.Project /= Project then
+ Dirs_Id := Pid.Project.Source_Dirs;
- if Suffix /= Nil_Variable_Value then
- Lang_Id.Config.Naming_Data.Spec_Suffix :=
- File_Name_Type (Suffix.Value);
+ Dir_Loop : while Dirs_Id /= Nil_String loop
+ Dir_Elem :=
+ Shared.String_Elements.Table (Dirs_Id);
+ Dirs_Id := Dir_Elem.Next;
- Check_Illegal_Suffix
- (Project,
- Lang_Id.Config.Naming_Data.Spec_Suffix,
- Lang_Id.Config.Naming_Data.Dot_Replacement,
- "Spec_Suffix", Suffix.Location, Data);
+ 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;
- Write_Attr
- ("Spec_Suffix",
- Get_Name_String (Lang_Id.Config.Naming_Data.Spec_Suffix));
- 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;
- -- Body_Suffix
+ Pid := Pid.Next;
+ end loop Project_Loop;
+ end if;
- Suffix :=
- Value_Of
- (Name => Lang,
- Attribute_Or_Array_Name => Name_Body_Suffix,
- In_Package => Naming_Id,
- Shared => Shared);
+ if not OK then
+ Project.Library_Dir := No_Path_Information;
- if Suffix = Nil_Variable_Value then
- Suffix :=
- Value_Of
- (Name => Lang,
- Attribute_Or_Array_Name => Name_Implementation_Suffix,
- In_Package => Naming_Id,
- Shared => Shared);
+ elsif Current_Verbosity = High then
+
+ -- Display the Library directory in high verbosity
+
+ Write_Attr
+ ("Library directory",
+ Get_Name_String (Project.Library_Dir.Display_Name));
+ end if;
+ end;
+ end if;
end if;
+ end if;
- if Suffix /= Nil_Variable_Value then
- Lang_Id.Config.Naming_Data.Body_Suffix :=
- File_Name_Type (Suffix.Value);
+ end if;
- -- The default value of separate suffix should be the same as
- -- the body suffix, so we need to compute that first.
+ Project.Library :=
+ Project.Library_Dir /= No_Path_Information
+ and then Project.Library_Name /= No_Name;
- 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;
+ 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;
- Check_Illegal_Suffix
- (Project,
- Lang_Id.Config.Naming_Data.Body_Suffix,
- Lang_Id.Config.Naming_Data.Dot_Replacement,
- "Body_Suffix", Suffix.Location, Data);
+ when 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);
- Write_Attr
- ("Body_Suffix",
- Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix));
+ if not Library_Directory_Present then
+ Error_Msg
+ (Data.Flags,
+ "\attribute Library_Dir not declared",
+ Project.Location, Project);
+ end if;
- elsif Separate_Suffix /= No_File then
- Lang_Id.Config.Naming_Data.Separate_Suffix := Separate_Suffix;
- end if;
+ elsif Project.Library_Dir = No_Path_Information then
+ Error_Msg
+ (Data.Flags,
+ "attribute Library_Dir not declared",
+ Project.Location, Project);
+ end if;
+ end if;
- -- 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.
+ when others =>
+ null;
- 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;
+ end case;
+ 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 then
+ Support_For_Libraries := Project.Config.Lib_Support;
- Lang_Id := Lang_Id.Next;
- end loop;
+ 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;
- -- Get the naming exceptions for all languages
+ else
+ if Lib_ALI_Dir.Value = Empty_String then
+ Debug_Output ("no library ALI directory specified");
+ Project.Library_ALI_Dir := Project.Library_Dir;
- 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
+ -- Find path name, check that it is a directory
- when Unit_Based =>
- Process_Exceptions_Unit_Based (Lang_Id, Kind);
- end case;
+ 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);
- Lang_Id := Lang_Id.Next;
- end loop;
- end loop;
- end Check_Naming;
+ if not Dir_Exists then
- ----------------------------
- -- Initialize_Naming_Data --
- ----------------------------
+ -- Get the absolute name of the library ALI directory that
+ -- does not exist, to report an error.
- procedure Initialize_Naming_Data is
- Specs : Array_Element_Id :=
- Util.Value_Of
- (Name_Spec_Suffix,
- Naming.Decl.Arrays,
- 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;
- Impls : Array_Element_Id :=
- Util.Value_Of
- (Name_Body_Suffix,
- Naming.Decl.Arrays,
- 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.
- Lang : Language_Ptr;
- Lang_Name : Name_Id;
- Value : Variable_Value;
- Extended : Project_Id;
+ 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;
- 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.
+ else
+ declare
+ OK : Boolean := True;
+ Dirs_Id : String_List_Id;
+ Dir_Elem : String_Element;
+ Pid : Project_List;
- 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
+ -- The library ALI directory cannot be the same as
+ -- a source directory of the current project.
- -- An extending project inherits its parent projects' languages
- -- so if needed we should create entries for those languages
+ Dirs_Id := Project.Source_Dirs;
+ 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_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;
- Extended := Extended.Extends;
- end loop;
+ if OK then
- 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;
+ -- The library ALI directory cannot be the same as
+ -- a source directory of another project either.
- -- If language was not found in project or the projects it extends
+ Pid := Data.Tree.Projects;
+ ALI_Project_Loop : loop
+ exit ALI_Project_Loop when Pid = null;
- if Lang = null then
- Debug_Output
- ("ignoring spec naming data (lang. not in project): ",
- Lang_Name);
+ if Pid.Project /= Project then
+ Dirs_Id := Pid.Project.Source_Dirs;
- else
- Value := Shared.Array_Elements.Table (Specs).Value;
+ ALI_Dir_Loop :
+ while Dirs_Id /= Nil_String loop
+ Dir_Elem :=
+ Shared.String_Elements.Table (Dirs_Id);
+ Dirs_Id := Dir_Elem.Next;
- if Value.Kind = Single then
- Lang.Config.Naming_Data.Spec_Suffix :=
- Canonical_Case_File_Name (Value.Value);
- end if;
- end if;
+ 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;
- Specs := Shared.Array_Elements.Table (Specs).Next;
- end loop;
+ 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;
- 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 not OK then
+ Project.Library_ALI_Dir := No_Path_Information;
- if Lang = null then
- Debug_Output
- ("ignoring impl naming data (lang. not in project): ",
- Lang_Name);
- else
- Value := Shared.Array_Elements.Table (Impls).Value;
+ elsif Current_Verbosity = High then
- if Lang.Name = Name_Ada then
- Ada_Body_Suffix_Loc := Value.Location;
- end if;
+ -- Display Library ALI directory in high verbosity
- if Value.Kind = Single then
- Lang.Config.Naming_Data.Body_Suffix :=
- Canonical_Case_File_Name (Value.Value);
+ Write_Attr
+ ("Library ALI dir",
+ Get_Name_String
+ (Project.Library_ALI_Dir.Display_Name));
+ end if;
+ end;
+ end if;
end if;
end if;
- Impls := Shared.Array_Elements.Table (Impls).Next;
- end loop;
- end Initialize_Naming_Data;
-
- -- Start of processing for Check_Naming_Schemes
-
- begin
- -- No Naming package or parsing a configuration file? nothing to do
+ pragma Assert (Lib_Version.Kind = Single);
- 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_Package_Naming;
+ if Lib_Version.Value = Empty_String then
+ Debug_Output ("no library version specified");
- ------------------------------
- -- Check_Library_Attributes --
- ------------------------------
+ else
+ Project.Lib_Internal_Name := Lib_Version.Value;
+ end if;
- procedure Check_Library_Attributes
- (Project : Project_Id;
- Data : in out Tree_Processing_Data)
- is
- Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
+ pragma Assert (The_Lib_Kind.Kind = Single);
- Attributes : constant Prj.Variable_Id := Project.Decl.Attributes;
+ if The_Lib_Kind.Value = Empty_String then
+ Debug_Output ("no library kind specified");
- Lib_Dir : constant Prj.Variable_Value :=
- Prj.Util.Value_Of
- (Snames.Name_Library_Dir, Attributes, Shared);
+ else
+ Get_Name_String (The_Lib_Kind.Value);
- Lib_Name : constant Prj.Variable_Value :=
- Prj.Util.Value_Of
- (Snames.Name_Library_Name, Attributes, Shared);
+ declare
+ Kind_Name : constant String :=
+ To_Lower (Name_Buffer (1 .. Name_Len));
- Lib_Version : constant Prj.Variable_Value :=
- Prj.Util.Value_Of
- (Snames.Name_Library_Version, Attributes, Shared);
+ OK : Boolean := True;
- Lib_ALI_Dir : constant Prj.Variable_Value :=
- Prj.Util.Value_Of
- (Snames.Name_Library_Ali_Dir, Attributes, Shared);
+ begin
+ if Kind_Name = "static" then
+ Project.Library_Kind := Static;
- Lib_GCC : constant Prj.Variable_Value :=
- Prj.Util.Value_Of
- (Snames.Name_Library_GCC, Attributes, Shared);
+ elsif Kind_Name = "dynamic" then
+ Project.Library_Kind := Dynamic;
- The_Lib_Kind : constant Prj.Variable_Value :=
- Prj.Util.Value_Of
- (Snames.Name_Library_Kind, Attributes, Shared);
+ elsif Kind_Name = "relocatable" then
+ Project.Library_Kind := Relocatable;
- Imported_Project_List : Project_List;
+ else
+ Error_Msg
+ (Data.Flags,
+ "illegal value for Library_Kind",
+ The_Lib_Kind.Location, Project);
+ OK := False;
+ end if;
- Continuation : String_Access := No_Continuation_String'Access;
+ if Current_Verbosity = High and then OK then
+ Write_Attr ("Library kind", Kind_Name);
+ end if;
- Support_For_Libraries : Library_Support;
+ 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;
- Library_Directory_Present : Boolean;
+ else
+ -- Check if (obsolescent) attribute Library_GCC or
+ -- Linker'Driver is declared.
- procedure Check_Library (Proj : Project_Id; Extends : Boolean);
- -- Check if an imported or extended project if also a library project
+ 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);
- -------------------
- -- Check_Library --
- -------------------
+ 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);
- procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
- Src_Id : Source_Id;
- Iter : Source_Iterator;
+ 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;
- begin
- if Proj /= No_Project then
- if not Proj.Library then
+ if Project.Library then
+ Debug_Output ("this is a library project file");
- -- 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.
+ Check_Library (Project.Extends, Extends => True);
- 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);
+ 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;
- if Src_Id /= No_Source then
- Error_Msg_Name_1 := Project.Name;
- Error_Msg_Name_2 := Proj.Name;
+ end if;
+ end if;
- 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;
+ -- 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.
- 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 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 Project.Library_Kind /= Static and then
- Proj.Library_Kind = Static
- then
- Error_Msg_Name_1 := Project.Name;
- Error_Msg_Name_2 := Proj.Name;
+ begin
+ if Linker_Package_Id /= No_Package then
+ Linker_Package := Shared.Packages.Table (Linker_Package_Id);
- if Extends then
- Error_Msg
- (Data.Flags,
- Continuation.all &
- "shared library project %% cannot extend static " &
- "library project %%",
- Project.Location, Project);
- Continuation := Continuation_String'Access;
+ Switches :=
+ Value_Of
+ (Name => Name_Switches,
+ In_Arrays => Linker_Package.Decl.Arrays,
+ Shared => Shared);
- elsif not Unchecked_Shared_Lib_Imports then
+ if Switches = No_Array_Element then
+ Switches :=
+ Value_Of
+ (Name => Name_Default_Switches,
+ In_Arrays => Linker_Package.Decl.Arrays,
+ Shared => Shared);
+ end if;
+
+ if Switches /= No_Array_Element then
Error_Msg
(Data.Flags,
- Continuation.all &
- "shared library project %% cannot import static " &
- "library project %%",
- Project.Location, Project);
- Continuation := Continuation_String'Access;
+ "?Linker switches not taken into account in library " &
+ "projects",
+ No_Location, Project);
end if;
-
end if;
- end if;
- end Check_Library;
-
- Dir_Exists : Boolean;
+ end;
+ end if;
- -- Start of processing for Check_Library_Attributes
+ if Project.Extends /= No_Project and then Project.Extends.Library then
- begin
- Library_Directory_Present := Lib_Dir.Value /= Empty_String;
+ -- Remove the library name from Lib_Data_Table
- -- Special case of extending project
+ 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 Project.Extends /= No_Project then
+ if Project.Library and then not Lib_Name.Default then
- -- 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.
+ -- Check if the same library name is used in an other library project
- if Project.Extends.Library then
- if Project.Qualifier = Standard then
+ 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,
- "a standard project cannot extend a library project",
- Project.Location, Project);
-
- else
- if Lib_Name.Default then
- Project.Library_Name := Project.Extends.Library_Name;
- end if;
+ "Library name cannot be the same as in project %%",
+ Lib_Name.Location, Project);
+ Project.Library := False;
+ exit;
+ end if;
+ end loop;
+ end if;
- 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);
+ if Project.Library then
- else
- -- For a virtual project extending a library project,
- -- inherit library directory and library kind.
+ -- Record the library name
- Project.Library_Dir := Project.Extends.Library_Dir;
- Library_Directory_Present := True;
- Project.Library_Kind := Project.Extends.Library_Kind;
- end if;
- end if;
- end if;
- end if;
+ Lib_Data_Table.Append
+ ((Name => Project.Library_Name, Proj => Project));
end if;
+ end Check_Library_Attributes;
- pragma Assert (Lib_Name.Kind = Single);
+ --------------------------
+ -- Check_Package_Naming --
+ --------------------------
- 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;
+ 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;
- else
- -- There is no restriction on the syntax of library names
+ Ada_Body_Suffix_Loc : Source_Ptr := No_Location;
- Project.Library_Name := Lib_Name.Value;
- end if;
+ procedure Check_Naming;
+ -- Check the validity of the Naming package (suffixes valid, ...)
- if Project.Library_Name /= No_Name then
- if Current_Verbosity = High then
- Write_Attr ("Library name: ",
- Get_Name_String (Project.Library_Name));
- end if;
+ 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
- pragma Assert (Lib_Dir.Kind = Single);
+ 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
- if not Library_Directory_Present then
- Debug_Output ("no library directory");
+ procedure Initialize_Naming_Data;
+ -- Initialize internal naming data for the various languages
- else
- -- Find path name (unless inherited), check that it is a directory
+ ------------------
+ -- Check_Common --
+ ------------------
- 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);
+ 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;
- else
- Dir_Exists :=
- Is_Directory
- (Get_Name_String
- (Project.Library_Dir.Display_Name));
+ 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;
- if not Dir_Exists then
+ Dot_Replacement := Canonical_Case_File_Name (Dot_Repl.Value);
+ Dot_Repl_Loc := Dot_Repl.Location;
- -- Get the absolute name of the library directory that
- -- does not exist, to report an error.
+ 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;
+
+ if Dot_Replacement /= No_File then
+ Write_Attr
+ ("Dot_Replacement", Get_Name_String (Dot_Replacement));
+ end if;
- 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);
+ Casing_Defined := False;
- elsif not Project.Externally_Built then
+ if not Casing_String.Default then
+ pragma Assert
+ (Casing_String.Kind = Single, "Casing is not a string");
- -- The library directory cannot be the same as the Object
- -- directory.
+ declare
+ Casing_Image : constant String :=
+ Get_Name_String (Casing_String.Value);
- if Project.Library_Dir.Name = Project.Object_Directory.Name then
+ begin
+ if Casing_Image'Length = 0 then
Error_Msg
(Data.Flags,
- "library directory cannot be the same " &
- "as object directory",
- Lib_Dir.Location, Project);
- Project.Library_Dir := No_Path_Information;
+ "Casing cannot be an empty string",
+ Casing_String.Location, Project);
+ end if;
- else
- declare
- OK : Boolean := True;
- Dirs_Id : String_List_Id;
- Dir_Elem : String_Element;
- Pid : Project_List;
+ Casing := Value (Casing_Image);
+ Casing_Defined := True;
- begin
- -- The library directory cannot be the same as a source
- -- directory of the current 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;
+ Error_Msg
+ (Data.Flags,
+ "%% is not a correct Casing",
+ Casing_String.Location, Project);
+ end;
+ end if;
- Dirs_Id := Project.Source_Dirs;
- while Dirs_Id /= Nil_String loop
- Dir_Elem := Shared.String_Elements.Table (Dirs_Id);
- Dirs_Id := Dir_Elem.Next;
+ Write_Attr ("Casing", Image (Casing));
- 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;
+ 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);
- if OK then
+ else
+ Separate_Suffix := Canonical_Case_File_Name (Sep_Suffix.Value);
+ Sep_Suffix_Loc := Sep_Suffix.Location;
- -- The library directory cannot be the same as a
- -- source directory of another project either.
+ Check_Illegal_Suffix
+ (Project, Separate_Suffix,
+ Dot_Replacement, "Separate_Suffix", Sep_Suffix.Location,
+ Data);
+ end if;
+ end if;
- Pid := Data.Tree.Projects;
- Project_Loop : loop
- exit Project_Loop when Pid = null;
+ if Separate_Suffix /= No_File then
+ Write_Attr
+ ("Separate_Suffix", Get_Name_String (Separate_Suffix));
+ end if;
+ end Check_Common;
- if Pid.Project /= Project then
- Dirs_Id := Pid.Project.Source_Dirs;
+ -----------------------------------
+ -- Process_Exceptions_File_Based --
+ -----------------------------------
- Dir_Loop : while Dirs_Id /= Nil_String loop
- Dir_Elem :=
- Shared.String_Elements.Table (Dirs_Id);
- Dirs_Id := Dir_Elem.Next;
+ 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;
- 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;
+ begin
+ case Kind is
+ when Impl | Sep =>
+ Exceptions :=
+ Value_Of
+ (Name_Implementation_Exceptions,
+ In_Arrays => Naming.Decl.Arrays,
+ Shared => Shared);
- 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;
+ when Spec =>
+ Exceptions :=
+ Value_Of
+ (Name_Specification_Exceptions,
+ In_Arrays => Naming.Decl.Arrays,
+ Shared => Shared);
+ end case;
- Pid := Pid.Next;
- end loop Project_Loop;
- end if;
+ Exception_List :=
+ Value_Of
+ (Index => Lang,
+ In_Array => Exceptions,
+ Shared => Shared);
- if not OK then
- Project.Library_Dir := No_Path_Information;
+ 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);
- elsif Current_Verbosity = High then
+ 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;
- -- Display the Library directory in high verbosity
+ 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);
- Write_Attr
- ("Library directory",
- Get_Name_String (Project.Library_Dir.Display_Name));
- end if;
- end;
- end if;
- end if;
- end if;
+ else
+ -- Check if the file name is already recorded for another
+ -- language or another kind.
- end if;
+ if Source.Language /= Lang_Id then
+ Error_Msg
+ (Data.Flags,
+ "the same file cannot be a source of two languages",
+ Element.Location, Project);
- Project.Library :=
- Project.Library_Dir /= No_Path_Information
- and then Project.Library_Name /= No_Name;
+ elsif Source.Kind /= Kind then
+ Error_Msg
+ (Data.Flags,
+ "the same file cannot be a source and a template",
+ Element.Location, Project);
+ end if;
- 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);
+ -- 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 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);
+ Element_Id := Element.Next;
+ end loop;
+ end if;
+ end Process_Exceptions_File_Based;
- if not Library_Directory_Present then
- Error_Msg
- (Data.Flags,
- "\attribute Library_Dir not declared",
- Project.Location, Project);
- end if;
+ -----------------------------------
+ -- Process_Exceptions_Unit_Based --
+ -----------------------------------
+
+ 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;
+
+ begin
+ case Kind is
+ when Impl | Sep =>
+ Exceptions :=
+ Value_Of
+ (Name_Body,
+ In_Arrays => Naming.Decl.Arrays,
+ Shared => Shared);
- elsif Project.Library_Dir = No_Path_Information then
- Error_Msg
- (Data.Flags,
- "attribute Library_Dir not declared",
- Project.Location, Project);
- end if;
+ if Exceptions = No_Array_Element then
+ Exceptions :=
+ Value_Of
+ (Name_Implementation,
+ In_Arrays => Naming.Decl.Arrays,
+ Shared => Shared);
end if;
- when others =>
- null;
+ when Spec =>
+ Exceptions :=
+ Value_Of
+ (Name_Spec,
+ In_Arrays => Naming.Decl.Arrays,
+ Shared => Shared);
+ if Exceptions = No_Array_Element then
+ Exceptions :=
+ Value_Of
+ (Name_Spec,
+ In_Arrays => Naming.Decl.Arrays,
+ Shared => Shared);
+ end if;
end case;
- end if;
-
- if Project.Library then
- Support_For_Libraries := Project.Config.Lib_Support;
-
- 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;
- else
- if Lib_ALI_Dir.Value = Empty_String then
- Debug_Output ("no library ALI directory specified");
- Project.Library_ALI_Dir := Project.Library_Dir;
-
- else
- -- Find path name, check that it is a directory
+ while Exceptions /= No_Array_Element loop
+ Element := Shared.Array_Elements.Table (Exceptions);
+ File_Name := Canonical_Case_File_Name (Element.Value.Value);
- 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);
+ Get_Name_String (Element.Index);
+ To_Lower (Name_Buffer (1 .. Name_Len));
+ Index := Element.Value.Index;
- if not Dir_Exists then
+ -- Check if it is a valid unit name
- -- Get the absolute name of the library ALI directory that
- -- does not exist, to report an error.
+ Get_Name_String (Element.Index);
+ Check_Unit_Name (Name_Buffer (1 .. Name_Len), Unit);
- 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;
+ 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 (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
+ 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.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;
+ Exceptions := Element.Next;
+ end loop;
+ end Process_Exceptions_Unit_Based;
- else
- declare
- OK : Boolean := True;
- Dirs_Id : String_List_Id;
- Dir_Elem : String_Element;
- Pid : Project_List;
+ ------------------
+ -- Check_Naming --
+ ------------------
- begin
- -- The library ALI directory cannot be the same as
- -- a source directory of the current 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;
- Dirs_Id := Project.Source_Dirs;
- while Dirs_Id /= Nil_String loop
- Dir_Elem := Shared.String_Elements.Table (Dirs_Id);
- Dirs_Id := Dir_Elem.Next;
+ begin
+ Check_Common
+ (Dot_Replacement => Dot_Replacement,
+ Casing => Casing,
+ Casing_Defined => Casing_Defined,
+ Separate_Suffix => Separate_Suffix,
+ Sep_Suffix_Loc => Sep_Suffix_Loc);
- 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;
+ -- 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 OK then
+ 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;
- -- The library ALI directory cannot be the same as
- -- a source directory of another project either.
+ if Casing_Defined then
+ Lang_Id.Config.Naming_Data.Casing := Casing;
+ end if;
+ end if;
- Pid := Data.Tree.Projects;
- ALI_Project_Loop : loop
- exit ALI_Project_Loop when Pid = null;
+ Lang_Id := Lang_Id.Next;
+ end loop;
+ end if;
- if Pid.Project /= Project then
- Dirs_Id := Pid.Project.Source_Dirs;
+ -- Next, get the spec and body suffixes
- ALI_Dir_Loop :
- while Dirs_Id /= Nil_String loop
- Dir_Elem :=
- Shared.String_Elements.Table (Dirs_Id);
- Dirs_Id := Dir_Elem.Next;
+ Lang_Id := Project.Languages;
+ while Lang_Id /= No_Language_Index loop
+ Lang := Lang_Id.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;
+ -- Spec_Suffix
- 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;
+ Suffix := Value_Of
+ (Name => Lang,
+ Attribute_Or_Array_Name => Name_Spec_Suffix,
+ In_Package => Naming_Id,
+ Shared => Shared);
- if not OK then
- Project.Library_ALI_Dir := No_Path_Information;
+ 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;
- elsif Current_Verbosity = High then
+ if Suffix /= Nil_Variable_Value then
+ Lang_Id.Config.Naming_Data.Spec_Suffix :=
+ File_Name_Type (Suffix.Value);
- -- Display Library ALI directory in high verbosity
+ 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
- ("Library ALI dir",
- Get_Name_String
- (Project.Library_ALI_Dir.Display_Name));
- end if;
- end;
- end if;
- end if;
+ 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 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
- 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);
+ 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 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
+
+ if Lang = null then
+ Debug_Output
+ ("ignoring spec naming data (lang. not in project): ",
+ Lang_Name);
- -- Remove the library name from Lib_Data_Table
+ else
+ Value := Shared.Array_Elements.Table (Specs).Value;
- 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;
+ 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 --
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 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;
+
+ 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;
+
+ -- Special cases of children of packages A, G, I and S on VMS
+
+ if OpenVMS_On_Target
+ and then Name_Len > 3
+ and then Name_Buffer (2 .. 3) = "__"
+ and then
+ ((Name_Buffer (1) = 'a') or else
+ (Name_Buffer (1) = 'g') or else
+ (Name_Buffer (1) = 'i') or else
+ (Name_Buffer (1) = 's'))
+ then
+ Name_Buffer (2) := '.';
+ Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len);
+ Name_Len := Name_Len - 1;
+ end if;
+
+ Real_Name := Name_Find;
+
+ if Is_Reserved (Real_Name) then
+ 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
+
+ Last_Underscore := False;
+
+ if not Is_Alphanumeric (The_Name (Index)) then
+ 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 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_Unit_Name;
+
----------------------------
-- Compute_Directory_Last --
----------------------------
Src : Source_Info;
Id : Source_Id;
Lang_Id : Language_Ptr;
+
begin
Initialize (Iter, Project.Project.Name);
projects / platform / upstream / gcc.git / commitdiff