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

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;
+         Free_List (Project.Languages);
 
          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,18 +939,19 @@ 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
 
-         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);
@@ -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,