-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2008, 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;
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,
Externally_Built => False,
Config => Default_Project_Config,
Languages => No_Name_List,
- First_Referred_By => No_Project,
Name => No_Name,
Display_Name => No_Name,
Path => No_Path_Information,
Ada_Sources_Present => True,
Other_Sources_Present => True,
Ada_Sources => Nil_String,
- Sources => Nil_String,
First_Source => No_Source,
Last_Source => No_Source,
Interfaces_Defined => False,
- Unit_Based_Language_Name => No_Name,
- Unit_Based_Language_Index => No_Language_Index,
Imported_Directories_Switches => null,
Include_Path => null,
Include_Data_Set => False,
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,
-- 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.
+ procedure Free (Project : in out Project_Data);
+ -- Free memory allocated for Project
+
-------------------
-- Add_To_Buffer --
-------------------
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;
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
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 --
-----------