+2009-04-29 Emmanuel Briot <briot@adacore.com>
+
+ * prj-ext.adb, prj.adb, prj.ads: Fix memory leaks.
+
+ * clean.adb (Ultimate_Extension_Of): removed, since duplicate of
+ Prj.Ultimate_Extending_Project_Of
+
2009-04-29 Ed Schonberg <schonberg@adacore.com>
* exp_ch7.adb (Build_Final_List): If the designated type is a Taft
-- Returns True iff Prj is an extension of Of_Project or if Of_Project is
-- an extension of Prj.
- function Ultimate_Extension_Of (Project : Project_Id) return Project_Id;
- -- Returns either Project, if it is not extended by another project, or
- -- the project that extends Project, directly or indirectly, and that is
- -- not itself extended. Returns No_Project if Project is No_Project.
-
procedure Usage;
-- Display the usage. If called several times, the usage is displayed only
-- the first time.
loop
Unit := Project_Tree.Units.Table (Index);
- if Ultimate_Extension_Of
+ if Ultimate_Extending_Project_Of
(Unit.File_Names (Body_Part).Project) = Project
and then
Get_Name_String
exit;
end if;
- if Ultimate_Extension_Of
+ if Ultimate_Extending_Project_Of
(Unit.File_Names (Specification).Project) = Project
and then
Get_Name_String
if Unit.File_Names (Body_Part).Project /=
No_Project
then
- if Ultimate_Extension_Of
+ if Ultimate_Extending_Project_Of
(Unit.File_Names (Body_Part).Project) =
Project
then
end if;
end if;
- elsif Ultimate_Extension_Of
+ elsif Ultimate_Extending_Project_Of
(Unit.File_Names (Specification).Project) =
Project
then
return Src & Tree_Suffix;
end Tree_File_Name;
- ---------------------------
- -- Ultimate_Extension_Of --
- ---------------------------
-
- function Ultimate_Extension_Of (Project : Project_Id) return Project_Id is
- Result : Project_Id := Project;
-
- begin
- if Project /= No_Project then
- loop
- exit when Result.Extended_By = No_Project;
- Result := Result.Extended_By;
- end loop;
- end if;
-
- return Result;
- end Ultimate_Extension_Of;
-
-----------
-- Usage --
-----------
-- --
-- B o d y --
-- --
--- Copyright (C) 2000-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-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- --
".." & Directory_Separator &
".." & Directory_Separator & "gnat");
end if;
+
+ Free (Prefix);
end;
end if;
-- 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_Id; Reset_Only : Boolean);
+ procedure Free (Project : in out Project_Id);
-- Free memory allocated for Project
procedure Free_List (Languages : in out Language_Ptr);
-- Free --
----------
- procedure Free (Project : in out Project_Id; Reset_Only : Boolean) is
+ procedure Free (Project : in out Project_Id) is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Project_Data, Project_Id);
Free (Project.Ada_Include_Path);
Free (Project.Objects_Path);
Free (Project.Ada_Objects_Path);
-
Free_List (Project.Imported_Projects, Free_Project => False);
Free_List (Project.All_Imported_Projects, Free_Project => False);
-
- if not Reset_Only then
- Free_List (Project.Languages);
- end if;
+ Free_List (Project.Languages);
Unchecked_Free (Project);
end if;
procedure Free_List
(List : in out Project_List;
- Free_Project : Boolean;
- Reset_Only : Boolean := True)
+ Free_Project : Boolean)
is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Project_List_Element, Project_List);
Tmp := List.Next;
if Free_Project then
- Free (List.Project, Reset_Only => Reset_Only);
+ Free (List.Project);
end if;
Unchecked_Free (List);
Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
- Free_List (Tree.Projects, Free_Project => True, Reset_Only => False);
+ Free_List (Tree.Projects, Free_Project => True);
-- Private part
- Naming_Table.Free (Tree.Private_Part.Namings);
- Path_File_Table.Free (Tree.Private_Part.Path_Files);
+ 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);
Free (Tree.Private_Part.Ada_Path_Buffer);
- -- Naming data (nothing to free ?)
+ -- Naming data (nothing to free ???)
+
null;
Unchecked_Free (Tree);
Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
- Free_List (Tree.Projects, Free_Project => True, Reset_Only => True);
+ Free_List (Tree.Projects, Free_Project => True);
-- Private part table
No_Path_Information : constant Path_Information := (No_Path, No_Path);
type Project_Data;
- type Project_Id is access Project_Data;
+ type Project_Id is access all Project_Data;
No_Project : constant Project_Id := null;
-- Id of a Project File
Next => No_Language_Index);
type Language_List_Element;
- type Language_List is access Language_List_Element;
+ type Language_List is access all Language_List_Element;
type Language_List_Element is record
Language : Language_Ptr := No_Language_Index;
Next : Language_List;
-- not considering Specs and Bodies.
type Project_List_Element;
- type Project_List is access Project_List_Element;
+ type Project_List is access all Project_List_Element;
type Project_List_Element is record
Project : Project_Id := No_Project;
Next : Project_List := null;
procedure Free_List
(List : in out Project_List;
- Free_Project : Boolean;
- Reset_Only : Boolean := True);
+ Free_Project : Boolean);
-- Free the list of projects. If Free_Project, each project is also freed.
- -- When Free_Project is True, Reset_Only indicates whether the specific
- -- languages should also be freed.
type Response_File_Format is
(None,