[multiple changes]

2010-06-22  Thomas Quinot  <quinot@adacore.com>

	* sem_elab.adb: Minor reformatting.

2010-06-22  Vincent Celier  <celier@adacore.com>

	* gnatsym.adb: Put the object files in the table in increasing
	aphabetical order of base names.

2010-06-22  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Set_Entity_Or_Discriminal): New procedure used by
	Find_Direct_Name and Find_Expanded_Name, to replace a discriminant with
	the corresponding discriminal within a record declaration.

From-SVN: r161196

4 files changed, 113 insertions, 68 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0af660d9..a7a0e64 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,20 @@
 2010-06-22  Thomas Quinot  <quinot@adacore.com>
 
+	* sem_elab.adb: Minor reformatting.
+
+2010-06-22  Vincent Celier  <celier@adacore.com>
+
+	* gnatsym.adb: Put the object files in the table in increasing
+	aphabetical order of base names.
+
+2010-06-22  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch8.adb (Set_Entity_Or_Discriminal): New procedure used by
+	Find_Direct_Name and Find_Expanded_Name, to replace a discriminant with
+	the corresponding discriminal within a record declaration.
+
+2010-06-22  Thomas Quinot  <quinot@adacore.com>
+
 	* exp_aggr.adb (Rewrite_Discriminant): Rewriting must occur only for an
 	expression referring to a discriminal of the type of the aggregate (not
 	a discriminal of some other unrelated type), and the prefix in the
diff --git a/gcc/ada/gnatsym.adb b/gcc/ada/gnatsym.adb
index dbea228..5a88994 100644
--- a/gcc/ada/gnatsym.adb
+++ b/gcc/ada/gnatsym.adb
@@ -41,19 +41,19 @@
 --    - (optional) the name of the reference symbol file
 --    - the names of one or more object files where the symbols are found
 
-with Ada.Exceptions; use Ada.Exceptions;
-with Ada.Text_IO;    use Ada.Text_IO;
-
-with GNAT.Command_Line; use GNAT.Command_Line;
-with GNAT.OS_Lib;       use GNAT.OS_Lib;
-
 with Gnatvsn; use Gnatvsn;
 with Osint;   use Osint;
 with Output;  use Output;
-
 with Symbols; use Symbols;
 with Table;
 
+with Ada.Exceptions; use Ada.Exceptions;
+with Ada.Text_IO;    use Ada.Text_IO;
+
+with GNAT.Command_Line;         use GNAT.Command_Line;
+with GNAT.Directory_Operations; use GNAT.Directory_Operations;
+with GNAT.OS_Lib;               use GNAT.OS_Lib;
+
 procedure Gnatsym is
 
    Empty_String : aliased String := "";
@@ -82,8 +82,13 @@ procedure Gnatsym is
    Version_String : String_Access := Empty;
    --  The version of the library (used on VMS)
 
+   type Object_File_Data is record
+      Path : String_Access;
+      Name : String_Access;
+   end record;
+
    package Object_Files is new Table.Table
-     (Table_Component_Type => String_Access,
+     (Table_Component_Type => Object_File_Data,
       Table_Index_Type     => Natural,
       Table_Low_Bound      => 0,
       Table_Initial        => 10,
@@ -164,7 +169,8 @@ procedure Gnatsym is
          end case;
       end loop;
 
-      --  Get the file names
+      --  Get the object file names and put them in the table in alphabetical
+      --  order of base names.
 
       loop
          declare
@@ -175,7 +181,26 @@ procedure Gnatsym is
             exit when S'Length = 0;
 
             Object_Files.Increment_Last;
-            Object_Files.Table (Object_Files.Last) := S;
+
+            declare
+               Base : constant String := Base_Name (S.all);
+               Last : constant Positive := Object_Files.Last;
+               J    : Positive;
+
+            begin
+               J := 1;
+               while J < Last loop
+                  if Object_Files.Table (J).Name.all > Base then
+                     Object_Files.Table (J + 1 .. Last) :=
+                       Object_Files.Table (J .. Last - 1);
+                     exit;
+                  end if;
+
+                  J := J + 1;
+               end loop;
+
+               Object_Files.Table (J) := (S, new String'(Base));
+            end;
          end;
       end loop;
    exception
@@ -304,11 +329,13 @@ begin
 
          if Verbose then
             Write_Str ("Processing object file """);
-            Write_Str (Object_Files.Table (Object_File).all);
+            Write_Str (Object_Files.Table (Object_File).Path.all);
             Write_Line ("""");
          end if;
 
-         Processing.Process (Object_Files.Table (Object_File).all, Success);
+         Processing.Process
+           (Object_Files.Table (Object_File).Path.all,
+            Success);
       end loop;
 
       --  Finalize the symbol file
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 3f1ea3b..374cfa7 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -407,6 +407,12 @@ package body Sem_Ch8 is
    --  is rewritten as a subprogram body that returns the attribute reference
    --  applied to the formals of the function.
 
+   procedure Set_Entity_Or_Discriminal (N : Node_Id; E : Entity_Id);
+   --  Set Entity, with style check if need be. For a discriminant
+   --  reference, replace by the corresponding discriminal, i.e. the
+   --  parameter of the initialization procedure that corresponds to
+   --  the discriminant.
+
    procedure Check_Frozen_Renaming (N : Node_Id; Subp : Entity_Id);
    --  A renaming_as_body may occur after the entity of the original decla-
    --  ration has been frozen. In that case, the body of the new entity must
@@ -3036,6 +3042,56 @@ package body Sem_Ch8 is
       end if;
    end Check_Frozen_Renaming;
 
+   -------------------------------
+   -- Set_Entity_Or_Discriminal --
+   -------------------------------
+
+   procedure Set_Entity_Or_Discriminal (N : Node_Id; E : Entity_Id) is
+      P : Node_Id;
+
+   begin
+      --  If the entity is not a discriminant, or else expansion is disabled,
+      --  simply set the entity.
+
+      if not In_Spec_Expression
+        or else Ekind (E) /= E_Discriminant
+        or else Inside_A_Generic
+      then
+         Set_Entity_With_Style_Check (N, E);
+
+      --  The replacement of a discriminant by the corresponding discriminal
+      --  is not done for a task discriminant that appears in a default
+      --  expression of an entry parameter. See Expand_Discriminant in exp_ch2
+      --  for details on their handling.
+
+      elsif Is_Concurrent_Type (Scope (E)) then
+
+         P := Parent (N);
+         while Present (P)
+           and then not Nkind_In (P, N_Parameter_Specification,
+                                  N_Component_Declaration)
+         loop
+            P := Parent (P);
+         end loop;
+
+         if Present (P)
+           and then Nkind (P) = N_Parameter_Specification
+         then
+            null;
+
+         else
+            Set_Entity (N, Discriminal (E));
+         end if;
+
+         --  Otherwise, this is a discriminant in a context in which
+         --  it is a reference to the corresponding parameter of the
+         --  init proc for the enclosing type.
+
+      else
+         Set_Entity (N, Discriminal (E));
+      end if;
+   end Set_Entity_Or_Discriminal;
+
    -----------------------------------
    -- Check_In_Previous_With_Clause --
    -----------------------------------
@@ -4498,58 +4554,7 @@ package body Sem_Ch8 is
                Check_Nested_Access (E);
             end if;
 
-            --  Set Entity, with style check if need be. For a discriminant
-            --  reference, replace by the corresponding discriminal, i.e. the
-            --  parameter of the initialization procedure that corresponds to
-            --  the discriminant. If this replacement is being performed, there
-            --  is no style check to perform.
-
-            --  This replacement must not be done if we are currently
-            --  processing a generic spec or body, because the discriminal
-            --  has not been not generated in this case.
-
-            --  The replacement is also skipped if we are in special
-            --  spec-expression mode. Why is this skipped in this case ???
-
-            if not In_Spec_Expression
-              or else Ekind (E) /= E_Discriminant
-              or else Inside_A_Generic
-            then
-               Set_Entity_With_Style_Check (N, E);
-
-            --  The replacement is not done either for a task discriminant that
-            --  appears in a default expression of an entry parameter. See
-            --  Expand_Discriminant in exp_ch2 for details on their handling.
-
-            elsif Is_Concurrent_Type (Scope (E)) then
-               declare
-                  P : Node_Id;
-
-               begin
-                  P := Parent (N);
-                  while Present (P)
-                    and then not Nkind_In (P, N_Parameter_Specification,
-                                              N_Component_Declaration)
-                  loop
-                     P := Parent (P);
-                  end loop;
-
-                  if Present (P)
-                     and then Nkind (P) = N_Parameter_Specification
-                  then
-                     null;
-                  else
-                     Set_Entity (N, Discriminal (E));
-                  end if;
-               end;
-
-            --  Otherwise, this is a discriminant in a context in which
-            --  it is a reference to the corresponding parameter of the
-            --  init proc for the enclosing type.
-
-            else
-               Set_Entity (N, Discriminal (E));
-            end if;
+            Set_Entity_Or_Discriminal (N, E);
          end if;
       end;
    end Find_Direct_Name;
@@ -4945,7 +4950,7 @@ package body Sem_Ch8 is
       if Has_Homonym (Id) then
          Set_Entity (N, Id);
       else
-         Set_Entity_With_Style_Check (N, Id);
+         Set_Entity_Or_Discriminal (N, Id);
          Generate_Reference (Id, N);
       end if;
 
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index 452f1e3..74aac9e 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -599,9 +599,7 @@ package body Sem_Elab is
 
       --  No checks needed for pure or preelaborated compilation units
 
-      if Is_Pure (E_Scope)
-        or else Is_Preelaborated (E_Scope)
-      then
+      if Is_Pure (E_Scope) or else Is_Preelaborated (E_Scope) then
          return;
       end if;