2009-06-29 Basile Starynkevitch <basile@starynkevitch.net>

	MELT branch merged with trunk r149060



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@149081 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 90 insertions, 125 deletions

diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index 9e335d1b5df..68ed4c77718 100644
--- a/gcc/ada/gnatcmd.adb
+++ b/gcc/ada/gnatcmd.adb
@@ -306,7 +306,7 @@ procedure GNATCmd is
 
    procedure Check_Files is
       Add_Sources : Boolean := True;
-      Unit_Data   : Prj.Unit_Data;
+      Unit        : Prj.Unit_Index;
       Subunit     : Boolean := False;
       FD          : File_Descriptor := Invalid_FD;
       Status      : Integer;
@@ -330,36 +330,36 @@ procedure GNATCmd is
          --  For gnatcheck, gnatpp and gnatmetric , create a temporary file and
          --  put the list of sources in it.
 
-         if The_Command = Check
-            or else The_Command = Pretty
-            or else The_Command = Metric
+         if The_Command = Check  or else
+            The_Command = Pretty or else
+            The_Command = Metric
          then
             Tempdir.Create_Temp_File (FD, Temp_File_Name);
             Last_Switches.Increment_Last;
             Last_Switches.Table (Last_Switches.Last) :=
               new String'("-files=" & Get_Name_String (Temp_File_Name));
-
          end if;
 
          declare
-            Proj         : Project_List;
+            Proj : Project_List;
 
          begin
-            --  Gnatstack needs to add the .ci file for the binder
-            --  generated files corresponding to all of the library projects
-            --  and main units belonging to the application.
+            --  Gnatstack needs to add the .ci file for the binder generated
+            --  files corresponding to all of the library projects and main
+            --  units belonging to the application.
 
             if The_Command = Stack then
                Proj := Project_Tree.Projects;
                while Proj /= null loop
                   if Check_Project (Proj.Project, Project) then
                      declare
-                        Main : String_List_Id := Proj.Project.Mains;
+                        Main : String_List_Id;
                         File : String_Access;
 
                      begin
                         --  Include binder generated files for main programs
 
+                        Main := Proj.Project.Mains;
                         while Main /= Nil_String loop
                            File :=
                              new String'
@@ -409,49 +409,39 @@ procedure GNATCmd is
                end loop;
             end if;
 
-            for Unit in Unit_Table.First ..
-                        Unit_Table.Last (Project_Tree.Units)
-            loop
-               Unit_Data := Project_Tree.Units.Table (Unit);
+            Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
+            while Unit /= No_Unit_Index loop
 
                --  For gnatls, we only need to put the library units, body or
                --  spec, but not the subunits.
 
                if The_Command = List then
-                  if
-                    Unit_Data.File_Names (Body_Part).Name /= No_File
-                      and then
-                    Unit_Data.File_Names (Body_Part).Path.Name /= Slash
+                  if Unit.File_Names (Impl) /= null
+                    and then not Unit.File_Names (Impl).Locally_Removed
                   then
                      --  There is a body, check if it is for this project
 
                      if All_Projects or else
-                        Unit_Data.File_Names (Body_Part).Project = Project
+                        Unit.File_Names (Impl).Project = Project
                      then
                         Subunit := False;
 
-                        if
-                          Unit_Data.File_Names (Specification).Name = No_File
-                            or else
-                            Unit_Data.File_Names
-                              (Specification).Path.Name = Slash
+                        if Unit.File_Names (Spec) = null
+                          or else Unit.File_Names (Spec).Locally_Removed
                         then
                            --  We have a body with no spec: we need to check if
                            --  this is a subunit, because gnatls will complain
                            --  about subunits.
 
                            declare
-                              Src_Ind : Source_File_Index;
-
+                              Src_Ind : constant Source_File_Index :=
+                                          Sinput.P.Load_Project_File
+                                            (Get_Name_String
+                                              (Unit.File_Names
+                                                (Impl).Path.Name));
                            begin
-                              Src_Ind := Sinput.P.Load_Project_File
-                                (Get_Name_String
-                                   (Unit_Data.File_Names
-                                      (Body_Part).Path.Name));
-
                               Subunit :=
-                                Sinput.P.Source_File_Is_Subunit
-                                  (Src_Ind);
+                                Sinput.P.Source_File_Is_Subunit (Src_Ind);
                            end;
                         end if;
 
@@ -460,28 +450,24 @@ procedure GNATCmd is
                            Last_Switches.Table (Last_Switches.Last) :=
                              new String'
                                (Get_Name_String
-                                    (Unit_Data.File_Names
-                                         (Body_Part).Display_Name));
+                                    (Unit.File_Names
+                                         (Impl).Display_File));
                         end if;
                      end if;
 
-                  elsif
-                    Unit_Data.File_Names (Specification).Name /= No_File
-                      and then
-                    Unit_Data.File_Names (Specification).Path.Name /= Slash
+                  elsif Unit.File_Names (Spec) /= null
+                    and then not Unit.File_Names (Spec).Locally_Removed
                   then
-                     --  We have a spec with no body; check if it is for this
+                     --  We have a spec with no body. Check if it is for this
                      --  project.
 
                      if All_Projects or else
-                        Unit_Data.File_Names (Specification).Project = Project
+                        Unit.File_Names (Spec).Project = Project
                      then
                         Last_Switches.Increment_Last;
                         Last_Switches.Table (Last_Switches.Last) :=
-                          new String'
-                            (Get_Name_String
-                                 (Unit_Data.File_Names
-                                      (Specification).Display_Name));
+                          new String'(Get_Name_String
+                                       (Unit.File_Names (Spec).Display_File));
                      end if;
                   end if;
 
@@ -491,39 +477,31 @@ procedure GNATCmd is
                --  but not the subunits.
 
                elsif The_Command = Stack then
-                  if
-                    Unit_Data.File_Names (Body_Part).Name /= No_File
-                      and then
-                    Unit_Data.File_Names (Body_Part).Path.Name /= Slash
+                  if Unit.File_Names (Impl) /= null
+                    and then not Unit.File_Names (Impl).Locally_Removed
                   then
                      --  There is a body. Check if .ci files for this project
                      --  must be added.
 
-                     if
-                       Check_Project
-                         (Unit_Data.File_Names (Body_Part).Project, Project)
+                     if Check_Project
+                          (Unit.File_Names (Impl).Project, Project)
                      then
                         Subunit := False;
 
-                        if
-                          Unit_Data.File_Names (Specification).Name = No_File
-                            or else
-                            Unit_Data.File_Names
-                              (Specification).Path.Name = Slash
+                        if Unit.File_Names (Spec) = null
+                          or else Unit.File_Names (Spec).Locally_Removed
                         then
                            --  We have a body with no spec: we need to check
                            --  if this is a subunit, because .ci files are not
                            --  generated for subunits.
 
                            declare
-                              Src_Ind : Source_File_Index;
-
+                              Src_Ind : constant Source_File_Index :=
+                                          Sinput.P.Load_Project_File
+                                            (Get_Name_String
+                                              (Unit.File_Names
+                                                (Impl).Path.Name));
                            begin
-                              Src_Ind := Sinput.P.Load_Project_File
-                                (Get_Name_String
-                                   (Unit_Data.File_Names
-                                      (Body_Part).Path.Name));
-
                               Subunit :=
                                 Sinput.P.Source_File_Is_Subunit (Src_Ind);
                            end;
@@ -534,43 +512,33 @@ procedure GNATCmd is
                            Last_Switches.Table (Last_Switches.Last) :=
                              new String'
                                (Get_Name_String
-                                    (Unit_Data.File_Names
-                                       (Body_Part).Project.
-                                         Object_Directory.Name)      &
-                                Directory_Separator                  &
+                                 (Unit.File_Names
+                                   (Impl).Project. Object_Directory.Name)  &
+                                Directory_Separator                        &
                                 MLib.Fil.Ext_To
                                   (Get_Name_String
-                                     (Unit_Data.File_Names
-                                        (Body_Part).Display_Name),
+                                     (Unit.File_Names (Impl).Display_File),
                                    "ci"));
                         end if;
                      end if;
 
-                  elsif
-                    Unit_Data.File_Names (Specification).Name /= No_File
-                    and then
-                    Unit_Data.File_Names (Specification).Path.Name /= Slash
+                  elsif Unit.File_Names (Spec) /= null
+                    and then not Unit.File_Names (Spec).Locally_Removed
                   then
-                     --  We have a spec with no body. Check if it is for this
-                     --  project.
+                     --  Spec with no body, check if it is for this project
 
-                     if
-                       Check_Project
-                         (Unit_Data.File_Names (Specification).Project,
-                          Project)
+                     if Check_Project
+                          (Unit.File_Names (Spec).Project, Project)
                      then
                         Last_Switches.Increment_Last;
                         Last_Switches.Table (Last_Switches.Last) :=
                           new String'
                             (Get_Name_String
-                                 (Unit_Data.File_Names
-                                   (Specification).Project.
-                                      Object_Directory.Name)         &
-                             Dir_Separator                           &
+                              (Unit.File_Names
+                                (Spec).Project. Object_Directory.Name)     &
+                             Dir_Separator                                 &
                              MLib.Fil.Ext_To
-                               (Get_Name_String
-                                  (Unit_Data.File_Names
-                                     (Specification).Name),
+                               (Get_Name_String (Unit.File_Names (Spec).File),
                                 "ci"));
                      end if;
                   end if;
@@ -581,14 +549,13 @@ procedure GNATCmd is
                   --  specified.
 
                   for Kind in Spec_Or_Body loop
-                     if Check_Project
-                          (Unit_Data.File_Names (Kind).Project, Project)
-                       and then Unit_Data.File_Names (Kind).Name /= No_File
-                       and then Unit_Data.File_Names (Kind).Path.Name /= Slash
+                     if Unit.File_Names (Kind) /= null
+                       and then Check_Project
+                                  (Unit.File_Names (Kind).Project, Project)
+                       and then not Unit.File_Names (Kind).Locally_Removed
                      then
                         Get_Name_String
-                          (Unit_Data.File_Names
-                             (Kind).Path.Display_Name);
+                          (Unit.File_Names (Kind).Path.Display_Name);
 
                         if FD /= Invalid_FD then
                            Name_Len := Name_Len + 1;
@@ -603,24 +570,25 @@ procedure GNATCmd is
                         else
                            Last_Switches.Increment_Last;
                            Last_Switches.Table (Last_Switches.Last) :=
-                             new String'
-                               (Get_Name_String
-                                    (Unit_Data.File_Names
-                                         (Kind).Path.Display_Name));
+                             new String'(Get_Name_String
+                                          (Unit.File_Names
+                                            (Kind).Path.Display_Name));
                         end if;
                      end if;
                   end loop;
-
-                  if FD /= Invalid_FD then
-                     Close (FD, Success);
-
-                     if not Success then
-                        Osint.Fail ("disk full");
-                     end if;
-                  end if;
                end if;
+
+               Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
             end loop;
          end;
+
+         if FD /= Invalid_FD then
+            Close (FD, Success);
+
+            if not Success then
+               Osint.Fail ("disk full");
+            end if;
+         end if;
       end if;
    end Check_Files;
 
@@ -694,8 +662,7 @@ procedure GNATCmd is
 
    function Configuration_Pragmas_File return Path_Name_Type is
    begin
-      Prj.Env.Create_Config_Pragmas_File
-        (Project, Project, Project_Tree, Include_Config_Files => False);
+      Prj.Env.Create_Config_Pragmas_File (Project, Project_Tree);
       return Project.Config_File_Name;
    end Configuration_Pragmas_File;
 
@@ -782,7 +749,7 @@ procedure GNATCmd is
       --  Used to read file if there is an error, it is good enough to display
       --  just 250 characters if the first line of the file is very long.
 
-      Udata : Unit_Data;
+      Unit  : Unit_Index;
       Path  : Path_Name_Type;
 
    begin
@@ -841,27 +808,26 @@ procedure GNATCmd is
             Get_Line (File, Line, Last);
             Path := No_Path;
 
-            for Unit in Unit_Table.First ..
-                        Unit_Table.Last (Project_Tree.Units)
-            loop
-               Udata := Project_Tree.Units.Table (Unit);
-
-               if Udata.File_Names (Specification).Name /= No_File
+            Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
+            while Unit /= No_Unit_Index loop
+               if Unit.File_Names (Spec) /= null
                  and then
-                   Get_Name_String (Udata.File_Names (Specification).Name) =
+                   Get_Name_String (Unit.File_Names (Spec).File) =
                       Line (1 .. Last)
                then
-                  Path := Udata.File_Names (Specification).Path.Name;
+                  Path := Unit.File_Names (Spec).Path.Name;
                   exit;
 
-               elsif Udata.File_Names (Body_Part).Name /= No_File
+               elsif Unit.File_Names (Impl) /= null
                  and then
-                   Get_Name_String (Udata.File_Names (Body_Part).Name) =
+                   Get_Name_String (Unit.File_Names (Impl).File) =
                      Line (1 .. Last)
                then
-                  Path := Udata.File_Names (Body_Part).Path.Name;
+                  Path := Unit.File_Names (Impl).Path.Name;
                   exit;
                end if;
+
+               Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
             end loop;
 
             Last_Switches.Increment_Last;
@@ -2155,6 +2121,8 @@ begin
                File_Index : Integer := 0;
                Dir_Index  : Integer := 0;
                Last       : constant Integer := Last_Switches.Last;
+               Lang       : constant Language_Ptr :=
+                              Get_Language_From_Name (Project, "ada");
 
             begin
                for Index in 1 .. Last loop
@@ -2171,7 +2139,7 @@ begin
                --  indicate to gnatstub the name of the body file with
                --  a -o switch.
 
-               if Body_Suffix_Id_Of (Project_Tree, Name_Ada, Project.Naming) /=
+               if Lang.Config.Naming_Data.Body_Suffix /=
                     Prj.Default_Ada_Spec_Suffix
                then
                   if File_Index /= 0 then
@@ -2181,9 +2149,7 @@ begin
                         Last : Natural := Spec'Last;
 
                      begin
-                        Get_Name_String
-                          (Spec_Suffix_Id_Of
-                             (Project_Tree, Name_Ada, Project.Naming));
+                        Get_Name_String (Lang.Config.Naming_Data.Spec_Suffix);
 
                         if Spec'Length > Name_Len
                           and then Spec (Last - Name_Len + 1 .. Last) =
@@ -2191,8 +2157,7 @@ begin
                         then
                            Last := Last - Name_Len;
                            Get_Name_String
-                             (Body_Suffix_Id_Of
-                                (Project_Tree, Name_Ada, Project.Naming));
+                             (Lang.Config.Naming_Data.Body_Suffix);
                            Last_Switches.Increment_Last;
                            Last_Switches.Table (Last_Switches.Last) :=
                              new String'("-o");