Skip to content

R
riscv-gcc-1
Commit d45871da by Emmanuel Briot Committed by Arnaud Charlet
Options

prj-ext.adb, [...]: Fix memory leaks. 

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

From-SVN: r146940
parent 4f87ded3
Showing with 26 additions and 47 deletions
gcc/ada/ChangeLog
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
......
gcc/ada/clean.adb
......@@ -242,11 +242,6 @@ package body Clean is
-- 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.
......@@ -582,7 +577,7 @@ package body Clean is
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
......@@ -593,7 +588,7 @@ package body Clean is
exit;
end if;
if Ultimate_Extension_Of
if Ultimate_Extending_Project_Of
(Unit.File_Names (Specification).Project) = Project
and then
Get_Name_String
......@@ -749,7 +744,7 @@ package body Clean is
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
......@@ -766,7 +761,7 @@ package body Clean is
end if;
end if;
elsif Ultimate_Extension_Of
elsif Ultimate_Extending_Project_Of
(Unit.File_Names (Specification).Project) =
Project
then
......@@ -1905,24 +1900,6 @@ package body Clean is
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 --
-----------
......
gcc/ada/prj-ext.adb
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -281,6 +281,8 @@ package body Prj.Ext is
".." & Directory_Separator &
".." & Directory_Separator & "gnat");
end if;
Free (Prefix);
end;
end if;
......
gcc/ada/prj.adb
......@@ -143,7 +143,7 @@ package body Prj is
-- 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);
......@@ -825,7 +825,7 @@ package body Prj is
-- 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);
......@@ -835,13 +835,9 @@ package body Prj is
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;
Unchecked_Free (Project);
end if;
......@@ -886,8 +882,7 @@ package body Prj is
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);
......@@ -898,7 +893,7 @@ package body Prj is
Tmp := List.Next;
if Free_Project then
Free (List.Project, Reset_Only => Reset_Only);
Free (List.Project);
end if;
Unchecked_Free (List);
......@@ -944,7 +939,7 @@ package body Prj is
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
......@@ -955,7 +950,8 @@ package body Prj is
Free (Tree.Private_Part.Ada_Path_Buffer);
-- Naming data (nothing to free ?)
-- Naming data (nothing to free ???)
null;
Unchecked_Free (Tree);
......@@ -981,7 +977,7 @@ package body Prj is
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
......
gcc/ada/prj.ads
......@@ -161,7 +161,7 @@ package Prj is
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
......@@ -604,7 +604,7 @@ package Prj is
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;
......@@ -928,7 +928,7 @@ package Prj is
-- 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;
......@@ -937,11 +937,8 @@ package Prj is
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,
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment