From: Arnaud Charlet Date: Tue, 22 Jun 2010 15:41:47 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=4c484f40927f5b3727b12a7cd07d6ad2475ce390;p=gcc.git [multiple changes] 2010-06-22 Thomas Quinot * sem_elab.adb: Minor reformatting. 2010-06-22 Vincent Celier * gnatsym.adb: Put the object files in the table in increasing aphabetical order of base names. 2010-06-22 Ed Schonberg * 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0af660d9f32..a7a0e645fb7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2010-06-22 Thomas Quinot + + * sem_elab.adb: Minor reformatting. + +2010-06-22 Vincent Celier + + * gnatsym.adb: Put the object files in the table in increasing + aphabetical order of base names. + +2010-06-22 Ed Schonberg + + * 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 * exp_aggr.adb (Rewrite_Discriminant): Rewriting must occur only for an diff --git a/gcc/ada/gnatsym.adb b/gcc/ada/gnatsym.adb index dbea228ebbe..5a88994a4c4 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 3f1ea3bc56b..374cfa7a8ed 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 452f1e36e53..74aac9e5e0e 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;