-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2009, 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 Ada.Characters.Handling; use Ada.Characters.Handling;
+with Ada.Unchecked_Deallocation;
with Debug;
with Output; use Output;
with Prj.Env;
with Prj.Err; use Prj.Err;
with Snames; use Snames;
+with Table;
with Uintp; use Uintp;
with System.Case_Util; use System.Case_Util;
+with System.HTable;
package body Prj is
The_Empty_String : Name_Id;
- Name_C_Plus_Plus : Name_Id;
-
Default_Ada_Spec_Suffix_Id : File_Name_Type;
Default_Ada_Body_Suffix_Id : File_Name_Type;
Slash_Id : Path_Name_Type;
Std_Naming_Data : constant Naming_Data :=
(Dot_Replacement => Standard_Dot_Replacement,
- Dot_Repl_Loc => No_Location,
Casing => All_Lower_Case,
Spec_Suffix => No_Array_Element,
- Ada_Spec_Suffix_Loc => No_Location,
Body_Suffix => No_Array_Element,
- Ada_Body_Suffix_Loc => No_Location,
Separate_Suffix => No_File,
- Sep_Suffix_Loc => No_Location,
Specs => No_Array_Element,
Bodies => No_Array_Element,
Specification_Exceptions => No_Array_Element,
- Implementation_Exceptions => No_Array_Element,
- Impl_Suffixes => No_Impl_Suffixes,
- Supp_Suffixes => No_Supp_Language_Index);
+ Implementation_Exceptions => No_Array_Element);
Project_Empty : constant Project_Data :=
- (Externally_Built => False,
- Config => Default_Project_Config,
- Languages => No_Name_List,
- First_Referred_By => No_Project,
- Name => No_Name,
- Display_Name => No_Name,
- Path_Name => No_Path,
- Display_Path_Name => No_Path,
- Virtual => False,
- Location => No_Location,
- Mains => Nil_String,
- Directory => No_Path,
- Display_Directory => No_Path,
- Dir_Path => null,
- Library => False,
- Library_Dir => No_Path,
- Display_Library_Dir => No_Path,
- Library_Src_Dir => No_Path,
- Display_Library_Src_Dir => No_Path,
- Library_ALI_Dir => No_Path,
- Display_Library_ALI_Dir => No_Path,
- Library_Name => No_Name,
- Library_Kind => Static,
- Lib_Internal_Name => No_Name,
- Standalone_Library => False,
- Lib_Interface_ALIs => Nil_String,
- Lib_Auto_Init => False,
- Libgnarl_Needed => Unknown,
- Symbol_Data => No_Symbols,
- Ada_Sources => Nil_String,
- Sources => Nil_String,
- First_Source => No_Source,
- Last_Source => No_Source,
- Unit_Based_Language_Name => No_Name,
- Unit_Based_Language_Index => No_Language_Index,
- Imported_Directories_Switches => null,
- Include_Path => null,
- Include_Data_Set => False,
- Include_Language => No_Language_Index,
- Source_Dirs => Nil_String,
- Known_Order_Of_Source_Dirs => True,
- Object_Directory => No_Path,
- Display_Object_Dir => No_Path,
- Library_TS => Empty_Time_Stamp,
- Exec_Directory => No_Path,
- Display_Exec_Dir => No_Path,
- Extends => No_Project,
- Extended_By => No_Project,
- Naming => Std_Naming_Data,
- First_Language_Processing => No_Language_Index,
- Decl => No_Declarations,
- Imported_Projects => Empty_Project_List,
- All_Imported_Projects => Empty_Project_List,
- Ada_Include_Path => null,
- Ada_Objects_Path => null,
- Objects_Path => null,
- Include_Path_File => No_Path,
- Objects_Path_File_With_Libs => No_Path,
- Objects_Path_File_Without_Libs => No_Path,
- Config_File_Name => No_Path,
- Config_File_Temp => False,
- Linker_Name => No_File,
- Linker_Path => No_Path,
- Minimum_Linker_Options => No_Name_List,
- Config_Checked => False,
- Checked => False,
- Seen => False,
- Need_To_Build_Lib => False,
- Depth => 0,
- Unkept_Comments => False,
- Langs => No_Languages,
- Supp_Languages => No_Supp_Language_Index,
- Ada_Sources_Present => True,
- Other_Sources_Present => True,
- First_Other_Source => No_Other_Source,
- Last_Other_Source => No_Other_Source,
- First_Lang_Processing => Default_First_Language_Processing_Data,
- Supp_Language_Processing => No_Supp_Language_Index);
+ (Qualifier => Unspecified,
+ Externally_Built => False,
+ Config => Default_Project_Config,
+ Languages => No_Name_List,
+ Name => No_Name,
+ Display_Name => No_Name,
+ Path => No_Path_Information,
+ Virtual => False,
+ Location => No_Location,
+ Mains => Nil_String,
+ Directory => No_Path_Information,
+ Dir_Path => null,
+ Library => False,
+ Library_Dir => No_Path_Information,
+ Library_Src_Dir => No_Path_Information,
+ Library_ALI_Dir => No_Path_Information,
+ Library_Name => No_Name,
+ Library_Kind => Static,
+ Lib_Internal_Name => No_Name,
+ Standalone_Library => False,
+ Lib_Interface_ALIs => Nil_String,
+ Lib_Auto_Init => False,
+ Libgnarl_Needed => Unknown,
+ Symbol_Data => No_Symbols,
+ Ada_Sources_Present => True,
+ Other_Sources_Present => True,
+ Ada_Sources => Nil_String,
+ First_Source => No_Source,
+ Last_Source => No_Source,
+ Interfaces_Defined => False,
+ Imported_Directories_Switches => null,
+ Include_Path => null,
+ Include_Data_Set => False,
+ Include_Language => No_Language_Index,
+ Source_Dirs => Nil_String,
+ Known_Order_Of_Source_Dirs => True,
+ Object_Directory => No_Path_Information,
+ Library_TS => Empty_Time_Stamp,
+ Exec_Directory => No_Path_Information,
+ Extends => No_Project,
+ Extended_By => No_Project,
+ Naming => Std_Naming_Data,
+ First_Language_Processing => No_Language_Index,
+ Decl => No_Declarations,
+ Imported_Projects => Empty_Project_List,
+ All_Imported_Projects => Empty_Project_List,
+ Ada_Include_Path => null,
+ Ada_Objects_Path => null,
+ Objects_Path => null,
+ Include_Path_File => No_Path,
+ Objects_Path_File_With_Libs => No_Path,
+ Objects_Path_File_Without_Libs => No_Path,
+ Config_File_Name => No_Path,
+ Config_File_Temp => False,
+ Config_Checked => False,
+ Checked => False,
+ Seen => False,
+ Need_To_Build_Lib => False,
+ Depth => 0,
+ Unkept_Comments => False);
package Temp_Files is new Table.Table
(Table_Component_Type => Path_Name_Type,
-- Table to store the path name of all the created temporary files, so that
-- they can be deleted at the end, or when the program is interrupted.
- -----------------------
- -- Add_Language_Name --
- -----------------------
-
- procedure Add_Language_Name (Name : Name_Id) is
- begin
- Last_Language_Index := Last_Language_Index + 1;
- Language_Indexes.Set (Name, Last_Language_Index);
- Language_Names.Increment_Last;
- Language_Names.Table (Last_Language_Index) := Name;
- end Add_Language_Name;
+ procedure Free (Project : in out Project_Data);
+ -- Free memory allocated for Project
-------------------
-- Add_To_Buffer --
return "";
end Body_Suffix_Of;
- function Body_Suffix_Of
- (Language : Language_Index;
- In_Project : Project_Data;
- In_Tree : Project_Tree_Ref) return String
- is
- Suffix_Id : constant File_Name_Type :=
- Suffix_Of (Language, In_Project, In_Tree);
- begin
- if Suffix_Id /= No_File then
- return Get_Name_String (Suffix_Id);
- else
- return "." & Get_Name_String (Language_Names.Table (Language));
- end if;
- end Body_Suffix_Of;
-
-----------------------------
-- Default_Ada_Body_Suffix --
-----------------------------
Write_Str (Name_Buffer (1 .. Name_Len));
end Display_Language_Name;
- ---------------------------
- -- Display_Language_Name --
- ---------------------------
-
- procedure Display_Language_Name (Language : Language_Index) is
- begin
- Get_Name_String (Language_Names.Table (Language));
- To_Upper (Name_Buffer (1 .. 1));
- Write_Str (Name_Buffer (1 .. Name_Len));
- end Display_Language_Name;
-
----------------
-- Empty_File --
----------------
return Hash (Get_Name_String (Name));
end Hash;
+ function Hash (Project : Project_Id) return Header_Num is
+ begin
+ return Header_Num (Project mod Max_Header_Num);
+ end Hash;
+
-----------
-- Image --
-----------
Name_Len := 0;
The_Empty_String := Name_Find;
Empty_Name := The_Empty_String;
+ Empty_File_Name := File_Name_Type (The_Empty_String);
Name_Len := 4;
Name_Buffer (1 .. 4) := ".ads";
Default_Ada_Spec_Suffix_Id := Name_Find;
Name_Len := 1;
Name_Buffer (1) := '/';
Slash_Id := Name_Find;
- Name_Len := 3;
- Name_Buffer (1 .. 3) := "c++";
- Name_C_Plus_Plus := Name_Find;
Prj.Env.Initialize;
Prj.Attr.Initialize;
Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends));
Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
-
- Language_Indexes.Reset;
- Last_Language_Index := No_Language_Index;
- Language_Names.Init;
- Add_Language_Name (Name_Ada);
- Add_Language_Name (Name_C);
- Add_Language_Name (Name_C_Plus_Plus);
end if;
if Tree /= No_Project_Tree then
return False;
end Is_Extending;
- ----------------
- -- Is_Present --
- ----------------
-
- function Is_Present
- (Language : Language_Index;
- In_Project : Project_Data;
- In_Tree : Project_Tree_Ref) return Boolean
- is
- begin
- case Language is
- when No_Language_Index =>
- return False;
-
- when First_Language_Indexes =>
- return In_Project.Langs (Language);
-
- when others =>
- declare
- Supp : Supp_Language;
- Supp_Index : Supp_Language_Index;
-
- begin
- Supp_Index := In_Project.Supp_Languages;
- while Supp_Index /= No_Supp_Language_Index loop
- Supp := In_Tree.Present_Languages.Table (Supp_Index);
-
- if Supp.Index = Language then
- return Supp.Present;
- end if;
-
- Supp_Index := Supp.Next;
- end loop;
-
- return False;
- end;
- end case;
- end Is_Present;
-
- ---------------------------------
- -- Language_Processing_Data_Of --
- ---------------------------------
-
- function Language_Processing_Data_Of
- (Language : Language_Index;
- In_Project : Project_Data;
- In_Tree : Project_Tree_Ref) return Language_Processing_Data
- is
- begin
- case Language is
- when No_Language_Index =>
- return Default_Language_Processing_Data;
-
- when First_Language_Indexes =>
- return In_Project.First_Lang_Processing (Language);
-
- when others =>
- declare
- Supp : Supp_Language_Data;
- Supp_Index : Supp_Language_Index;
-
- begin
- Supp_Index := In_Project.Supp_Language_Processing;
- while Supp_Index /= No_Supp_Language_Index loop
- Supp := In_Tree.Supp_Languages.Table (Supp_Index);
-
- if Supp.Index = Language then
- return Supp.Data;
- end if;
-
- Supp_Index := Supp.Next;
- end loop;
-
- return Default_Language_Processing_Data;
- end;
- end case;
- end Language_Processing_Data_Of;
-
-----------------------
-- Objects_Exist_For --
-----------------------
if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
return
In_Tree.Languages_Data.Table
- (Lang).Config.Objects_Generated;
+ (Lang).Config.Object_Generated;
end if;
Lang := In_Tree.Languages_Data.Table (Lang).Next;
-----------------
function Object_Name
- (Source_File_Name : File_Name_Type)
+ (Source_File_Name : File_Name_Type;
+ Object_File_Suffix : Name_Id := No_Name)
return File_Name_Type
is
begin
- return Extend_Name (Source_File_Name, Object_Suffix);
+ if Object_File_Suffix = No_Name then
+ return Extend_Name
+ (Source_File_Name, Object_Suffix);
+ else
+ return Extend_Name
+ (Source_File_Name, Get_Name_String (Object_File_Suffix));
+ end if;
end Object_Name;
----------------------
end if;
end Register_Default_Naming_Scheme;
+ ----------
+ -- Free --
+ ----------
+
+ procedure Free (Project : in out Project_Data) is
+ begin
+ Free (Project.Dir_Path);
+ Free (Project.Include_Path);
+ Free (Project.Ada_Include_Path);
+ Free (Project.Objects_Path);
+ Free (Project.Ada_Objects_Path);
+ end Free;
+
+ ----------
+ -- Free --
+ ----------
+
+ procedure Free (Tree : in out Project_Tree_Ref) is
+ procedure Unchecked_Free is new Ada.Unchecked_Deallocation
+ (Project_Tree_Data, Project_Tree_Ref);
+ begin
+ if Tree /= null then
+ Language_Data_Table.Free (Tree.Languages_Data);
+ Name_List_Table.Free (Tree.Name_Lists);
+ String_Element_Table.Free (Tree.String_Elements);
+ Variable_Element_Table.Free (Tree.Variable_Elements);
+ Array_Element_Table.Free (Tree.Array_Elements);
+ Array_Table.Free (Tree.Arrays);
+ Package_Table.Free (Tree.Packages);
+ Project_List_Table.Free (Tree.Project_Lists);
+ Source_Data_Table.Free (Tree.Sources);
+ Alternate_Language_Table.Free (Tree.Alt_Langs);
+ Unit_Table.Free (Tree.Units);
+ Units_Htable.Reset (Tree.Units_HT);
+ Files_Htable.Reset (Tree.Files_HT);
+ Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
+ Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
+
+ for P in Project_Table.First ..
+ Project_Table.Last (Tree.Projects)
+ loop
+ Free (Tree.Projects.Table (P));
+ end loop;
+
+ Project_Table.Free (Tree.Projects);
+
+ -- Private part
+
+ Naming_Table.Free (Tree.Private_Part.Namings);
+ Path_File_Table.Free (Tree.Private_Part.Path_Files);
+ Source_Path_Table.Free (Tree.Private_Part.Source_Paths);
+ Object_Path_Table.Free (Tree.Private_Part.Object_Paths);
+
+ -- Naming data (nothing to free ?)
+ null;
+
+ Unchecked_Free (Tree);
+ end if;
+ end Free;
+
-----------
-- Reset --
-----------
procedure Reset (Tree : Project_Tree_Ref) is
-
- -- Def_Lang : constant Name_Node :=
- -- (Name => Name_Ada,
- -- Next => No_Name_List);
- -- Why is the above commented out ???
-
begin
Prj.Env.Initialize;
- -- gprmake tables
-
- Present_Language_Table.Init (Tree.Present_Languages);
- Supp_Suffix_Table.Init (Tree.Supp_Suffixes);
- Supp_Language_Table.Init (Tree.Supp_Languages);
- Other_Source_Table.Init (Tree.Other_Sources);
-
-- Visible tables
Language_Data_Table.Init (Tree.Languages_Data);
Array_Table.Init (Tree.Arrays);
Package_Table.Init (Tree.Packages);
Project_List_Table.Init (Tree.Project_Lists);
- Project_Table.Init (Tree.Projects);
Source_Data_Table.Init (Tree.Sources);
Alternate_Language_Table.Init (Tree.Alt_Langs);
Unit_Table.Init (Tree.Units);
Units_Htable.Reset (Tree.Units_HT);
Files_Htable.Reset (Tree.Files_HT);
Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
+ Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
+
+ if not Project_Table."=" (Tree.Projects.Table, null) then
+ for P in Project_Table.First ..
+ Project_Table.Last (Tree.Projects)
+ loop
+ Free (Tree.Projects.Table (P));
+ end loop;
+ end if;
+
+ Project_Table.Init (Tree.Projects);
-- Private part table
and then Left.Separate_Suffix = Right.Separate_Suffix;
end Same_Naming_Scheme;
- ---------
- -- Set --
- ---------
-
- procedure Set
- (Language : Language_Index;
- Present : Boolean;
- In_Project : in out Project_Data;
- In_Tree : Project_Tree_Ref)
- is
- begin
- case Language is
- when No_Language_Index =>
- null;
-
- when First_Language_Indexes =>
- In_Project.Langs (Language) := Present;
-
- when others =>
- declare
- Supp : Supp_Language;
- Supp_Index : Supp_Language_Index;
-
- begin
- Supp_Index := In_Project.Supp_Languages;
- while Supp_Index /= No_Supp_Language_Index loop
- Supp := In_Tree.Present_Languages.Table (Supp_Index);
-
- if Supp.Index = Language then
- In_Tree.Present_Languages.Table (Supp_Index).Present :=
- Present;
- return;
- end if;
-
- Supp_Index := Supp.Next;
- end loop;
-
- Supp := (Index => Language, Present => Present,
- Next => In_Project.Supp_Languages);
- Present_Language_Table.Increment_Last
- (In_Tree.Present_Languages);
- Supp_Index :=
- Present_Language_Table.Last (In_Tree.Present_Languages);
- In_Tree.Present_Languages.Table (Supp_Index) :=
- Supp;
- In_Project.Supp_Languages := Supp_Index;
- end;
- end case;
- end Set;
-
- procedure Set
- (Language_Processing : Language_Processing_Data;
- For_Language : Language_Index;
- In_Project : in out Project_Data;
- In_Tree : Project_Tree_Ref)
- is
- begin
- case For_Language is
- when No_Language_Index =>
- null;
-
- when First_Language_Indexes =>
- In_Project.First_Lang_Processing (For_Language) :=
- Language_Processing;
-
- when others =>
- declare
- Supp : Supp_Language_Data;
- Supp_Index : Supp_Language_Index;
-
- begin
- Supp_Index := In_Project.Supp_Language_Processing;
- while Supp_Index /= No_Supp_Language_Index loop
- Supp := In_Tree.Supp_Languages.Table (Supp_Index);
-
- if Supp.Index = For_Language then
- In_Tree.Supp_Languages.Table
- (Supp_Index).Data := Language_Processing;
- return;
- end if;
-
- Supp_Index := Supp.Next;
- end loop;
-
- Supp := (Index => For_Language, Data => Language_Processing,
- Next => In_Project.Supp_Language_Processing);
- Supp_Language_Table.Increment_Last
- (In_Tree.Supp_Languages);
- Supp_Index := Supp_Language_Table.Last
- (In_Tree.Supp_Languages);
- In_Tree.Supp_Languages.Table (Supp_Index) := Supp;
- In_Project.Supp_Language_Processing := Supp_Index;
- end;
- end case;
- end Set;
-
- procedure Set
- (Suffix : File_Name_Type;
- For_Language : Language_Index;
- In_Project : in out Project_Data;
- In_Tree : Project_Tree_Ref)
- is
- begin
- case For_Language is
- when No_Language_Index =>
- null;
-
- when First_Language_Indexes =>
- In_Project.Naming.Impl_Suffixes (For_Language) := Suffix;
-
- when others =>
- declare
- Supp : Supp_Suffix;
- Supp_Index : Supp_Language_Index;
-
- begin
- Supp_Index := In_Project.Naming.Supp_Suffixes;
- while Supp_Index /= No_Supp_Language_Index loop
- Supp := In_Tree.Supp_Suffixes.Table (Supp_Index);
-
- if Supp.Index = For_Language then
- In_Tree.Supp_Suffixes.Table (Supp_Index).Suffix := Suffix;
- return;
- end if;
-
- Supp_Index := Supp.Next;
- end loop;
-
- Supp := (Index => For_Language, Suffix => Suffix,
- Next => In_Project.Naming.Supp_Suffixes);
- Supp_Suffix_Table.Increment_Last (In_Tree.Supp_Suffixes);
- Supp_Index := Supp_Suffix_Table.Last (In_Tree.Supp_Suffixes);
- In_Tree.Supp_Suffixes.Table (Supp_Index) := Supp;
- In_Project.Naming.Supp_Suffixes := Supp_Index;
- end;
- end case;
- end Set;
-
---------------------
-- Set_Body_Suffix --
---------------------
if Tree = No_Project_Tree then
Prj.Initialize (Tree => No_Project_Tree);
return Std_Naming_Data;
-
else
return Tree.Private_Part.Default_Naming;
end if;
end Standard_Naming_Data;
- ---------------
- -- Suffix_Of --
- ---------------
-
- function Suffix_Of
- (Language : Language_Index;
- In_Project : Project_Data;
- In_Tree : Project_Tree_Ref) return File_Name_Type
- is
- begin
- case Language is
- when No_Language_Index =>
- return No_File;
-
- when First_Language_Indexes =>
- return In_Project.Naming.Impl_Suffixes (Language);
-
- when others =>
- declare
- Supp : Supp_Suffix;
- Supp_Index : Supp_Language_Index;
-
- begin
- Supp_Index := In_Project.Naming.Supp_Suffixes;
- while Supp_Index /= No_Supp_Language_Index loop
- Supp := In_Tree.Supp_Suffixes.Table (Supp_Index);
-
- if Supp.Index = Language then
- return Supp.Suffix;
- end if;
-
- Supp_Index := Supp.Next;
- end loop;
-
- return No_File;
- end;
- end case;
- end Suffix_Of;
-
-------------------
-- Switches_Name --
-------------------
return Extend_Name (Source_File_Name, Switches_Dependency_Suffix);
end Switches_Name;
- ---------------------------
- -- There_Are_Ada_Sources --
- ---------------------------
-
- function There_Are_Ada_Sources
- (In_Tree : Project_Tree_Ref;
- Project : Project_Id) return Boolean
- is
- Prj : Project_Id;
-
- begin
- Prj := Project;
- while Prj /= No_Project loop
- if In_Tree.Projects.Table (Prj).Ada_Sources /= Nil_String then
- return True;
- end if;
-
- Prj := In_Tree.Projects.Table (Prj).Extends;
- end loop;
-
- return False;
- end There_Are_Ada_Sources;
-
-----------
-- Value --
-----------
projects / gcc.git / blobdiff