From: Arnaud Charlet Date: Tue, 29 Jan 2013 14:31:08 +0000 (+0100) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=7096a67be07002e51b3fecaf0e5972172b717878;p=gcc.git [multiple changes] 2013-01-29 Thomas Quinot * sprint.adb (Sprint_Node_Actual): Output freeze nodes for itypes even if Dump_Freeze_Null is not set. 2013-01-29 Robert Dewar * sem_util.adb: Minor reformatting. * s-rident.ads: Minor comment fixes. 2013-01-29 Pascal Obry * prj-env.ads, prj-env.adb (Add_Directories): Add parameter to control if the path is prepended or appended. From-SVN: r195544 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 076ae03f833..f23c566acfb 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2013-01-29 Thomas Quinot + + * sprint.adb (Sprint_Node_Actual): Output freeze nodes for + itypes even if Dump_Freeze_Null is not set. + +2013-01-29 Robert Dewar + + * sem_util.adb: Minor reformatting. + * s-rident.ads: Minor comment fixes. + +2013-01-29 Pascal Obry + + * prj-env.ads, prj-env.adb (Add_Directories): Add parameter to + control if the path is prepended or appended. + 2013-01-29 Ed Schonberg * sem_ch6.adb (Analyze_Expression_Function): An expression diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index ddff02fcb92..d4bda03aac6 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2013, 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- -- @@ -1836,8 +1836,9 @@ package body Prj.Env is --------------------- procedure Add_Directories - (Self : in out Project_Search_Path; - Path : String) + (Self : in out Project_Search_Path; + Path : String; + Prepend : Boolean := False) is Tmp : String_Access; begin @@ -1845,7 +1846,11 @@ package body Prj.Env is Self.Path := new String'(Uninitialized_Prefix & Path); else Tmp := Self.Path; - Self.Path := new String'(Tmp.all & Path_Separator & Path); + if Prepend then + Self.Path := new String'(Path & Path_Separator & Tmp.all); + else + Self.Path := new String'(Tmp.all & Path_Separator & Path); + end if; Free (Tmp); end if; diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads index e2bb4448da5..39d805c2bc6 100644 --- a/gcc/ada/prj-env.ads +++ b/gcc/ada/prj-env.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2013, 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- -- @@ -189,8 +189,9 @@ package Prj.Env is -- Free the memory used by Self procedure Add_Directories - (Self : in out Project_Search_Path; - Path : String); + (Self : in out Project_Search_Path; + Path : String; + Prepend : Boolean := False); -- Add one or more directories to the path. Directories added with this -- procedure are added in order after the current directory and before the -- path given by the environment variable GPR_PROJECT_PATH. A value of "-" diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads index d0bc1066c0c..fcdf2ad87f7 100644 --- a/gcc/ada/s-rident.ads +++ b/gcc/ada/s-rident.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, 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- -- @@ -382,10 +382,11 @@ package System.Rident is -- value of the parameter permitted by the profile. end record; - Profile_Info : constant array (Profile_Name_Actual) of Profile_Data := + Profile_Info : constant array (Profile_Name_Actual) of Profile_Data := ( - (No_Implementation_Extensions => - -- Restrictions for Restricted profile + -- No_Implementation_Extensions profile + + No_Implementation_Extensions => (Set => (No_Implementation_Aspect_Specifications => True, diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index c467f50ac9f..0fc23655900 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -1242,7 +1242,8 @@ package body Sem_Util is -- Return the entity associated with the function call procedure Preanalyze_Without_Errors (N : Node_Id); - -- Preanalyze N without reporting errors + -- Preanalyze N without reporting errors. Very dubious, you can't just + -- go analyzing things more than once??? ------------------------- -- Collect_Identifiers -- @@ -1273,14 +1274,12 @@ package body Sem_Util is if No (Entity (N)) then return Skip; - -- We don't collect identifiers of packages, called functions, - -- etc. + -- Don't collect identifiers of packages, called functions, etc - elsif Ekind_In (Entity (N), - E_Package, - E_Function, - E_Procedure, - E_Entry) + elsif Ekind_In (Entity (N), E_Package, + E_Function, + E_Procedure, + E_Entry) then return Skip; @@ -1350,21 +1349,22 @@ package body Sem_Util is pragma Assert (Nkind (N) in N_Has_Entity); Elmt : Elmt_Id; + begin if List = No_Elist then return False; end if; Elmt := First_Elmt (List); - loop - if No (Elmt) then - return False; - elsif Entity (Node (Elmt)) = Entity (N) then + while Present (Elmt) loop + if Entity (Node (Elmt)) = Entity (N) then return True; else Next_Elmt (Elmt); end if; end loop; + + return False; end Contains; ------------------ @@ -1397,6 +1397,7 @@ package body Sem_Util is function Get_Function_Id (Call : Node_Id) return Entity_Id is Nam : constant Node_Id := Name (Call); Id : Entity_Id; + begin if Nkind (Nam) = N_Explicit_Dereference then Id := Etype (Nam); @@ -1432,15 +1433,14 @@ package body Sem_Util is begin if Ada_Version < Ada_2012 or else (not (Nkind (N) in N_Op) - and then not (Nkind (N) in N_Membership_Test) - and then not Nkind_In (N, - N_Range, - N_Aggregate, - N_Extension_Aggregate, - N_Full_Type_Declaration, - N_Function_Call, - N_Procedure_Call_Statement, - N_Entry_Call_Statement)) + and then not (Nkind (N) in N_Membership_Test) + and then not Nkind_In (N, N_Range, + N_Aggregate, + N_Extension_Aggregate, + N_Full_Type_Declaration, + N_Function_Call, + N_Procedure_Call_Statement, + N_Entry_Call_Statement)) or else (Nkind (N) = N_Full_Type_Declaration and then not Is_Record_Type (Defining_Identifier (N))) then @@ -1502,6 +1502,7 @@ package body Sem_Util is Comp : Node_Id; Def_Id : Entity_Id := Defining_Identifier (N); Rec : Node_Id := Get_Record_Part (N); + begin -- No need to perform any analysis if the record has no -- components @@ -1650,9 +1651,8 @@ package body Sem_Util is end loop; Num_Components := - Expr_Value (High_Bound (Aggregate_Bounds (N))) - - Expr_Value (Low_Bound (Aggregate_Bounds (N))) - + 1; + Expr_Value (High_Bound (Aggregate_Bounds (N))) - + Expr_Value (Low_Bound (Aggregate_Bounds (N))) + 1; pragma Assert (Count_Components <= Num_Components); @@ -1735,8 +1735,7 @@ package body Sem_Util is if Nkind (Choice) in N_Has_Entity and then Present (Entity (Choice)) - and then Ekind (Entity (Choice)) - = E_Discriminant + and then Ekind (Entity (Choice)) = E_Discriminant then null; diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index bfa245fd9dc..6aa045ff4e2 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, 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- -- @@ -70,7 +70,10 @@ package body Sprint is -- or for Print_Generated_Code (-gnatG) or Dump_Generated_Code (-gnatD). Dump_Freeze_Null : Boolean; - -- Set True if freeze nodes and non-source null statements output + -- Set True if empty freeze nodes and non-source null statements output. + -- Note that freeze nodes containing freeze actions are always output, + -- as are freeze nodes for itypes, which in general have the effect of + -- causing elaboration of the itype. Freeze_Indent : Int := 0; -- Keep track of freeze indent level (controls output of blank lines before @@ -1827,7 +1830,15 @@ package body Sprint is if Dump_Original_Only then null; - elsif Present (Actions (Node)) or else Dump_Freeze_Null then + -- A freeze node is output if it has some effect (i.e. non-empty + -- actions, or freeze node for an itype, which causes elaboration + -- of the itype), and is also always output if Dump_Freeze_Null + -- is set True. + + elsif Present (Actions (Node)) + or else Is_Itype (Entity (Node)) + or else Dump_Freeze_Null + then Write_Indent; Write_Rewrite_Str ("<<<"); Write_Str_With_Col_Check_Sloc ("freeze "); @@ -4084,7 +4095,7 @@ package body Sprint is when E_Modular_Integer_Type => Write_Header; - Write_Str (" mod "); + Write_Str ("mod "); Write_Uint_With_Col_Check (Modulus (Typ), Auto); -- Floating point types and subtypes