Skip to content

R
riscv-gcc-1
Commit 7096a67b by Arnaud Charlet
Options

[multiple changes] 

2013-01-29  Thomas Quinot  <quinot@adacore.com>

	* sprint.adb (Sprint_Node_Actual): Output freeze nodes for
	itypes even if Dump_Freeze_Null is not set.

2013-01-29  Robert Dewar  <dewar@adacore.com>

	* sem_util.adb: Minor reformatting.
	* s-rident.ads: Minor comment fixes.

2013-01-29  Pascal Obry  <obry@adacore.com>

	* prj-env.ads, prj-env.adb (Add_Directories): Add parameter to
	control if the path is prepended or appended.

From-SVN: r195544
parent a52e6d7e
Showing with 60 additions and 28 deletions
gcc/ada/ChangeLog
2013-01-29 Thomas Quinot <quinot@adacore.com>
* sprint.adb (Sprint_Node_Actual): Output freeze nodes for
itypes even if Dump_Freeze_Null is not set.
2013-01-29 Robert Dewar <dewar@adacore.com>
* sem_util.adb: Minor reformatting.
* s-rident.ads: Minor comment fixes.
2013-01-29 Pascal Obry <obry@adacore.com>
* prj-env.ads, prj-env.adb (Add_Directories): Add parameter to
control if the path is prepended or appended.
2013-01-29 Ed Schonberg <schonberg@adacore.com> 2013-01-29 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Expression_Function): An expression * sem_ch6.adb (Analyze_Expression_Function): An expression
......
gcc/ada/prj-env.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1837,7 +1837,8 @@ package body Prj.Env is ...@@ -1837,7 +1837,8 @@ package body Prj.Env is
procedure Add_Directories procedure Add_Directories
(Self : in out Project_Search_Path; (Self : in out Project_Search_Path;
Path : String) Path : String;
Prepend : Boolean := False)
is is
Tmp : String_Access; Tmp : String_Access;
begin begin
...@@ -1845,7 +1846,11 @@ package body Prj.Env is ...@@ -1845,7 +1846,11 @@ package body Prj.Env is
Self.Path := new String'(Uninitialized_Prefix & Path); Self.Path := new String'(Uninitialized_Prefix & Path);
else else
Tmp := Self.Path; Tmp := Self.Path;
if Prepend then
Self.Path := new String'(Path & Path_Separator & Tmp.all);
else
Self.Path := new String'(Tmp.all & Path_Separator & Path); Self.Path := new String'(Tmp.all & Path_Separator & Path);
end if;
Free (Tmp); Free (Tmp);
end if; end if;
......
gcc/ada/prj-env.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -190,7 +190,8 @@ package Prj.Env is ...@@ -190,7 +190,8 @@ package Prj.Env is
procedure Add_Directories procedure Add_Directories
(Self : in out Project_Search_Path; (Self : in out Project_Search_Path;
Path : String); Path : String;
Prepend : Boolean := False);
-- Add one or more directories to the path. Directories added with this -- Add one or more directories to the path. Directories added with this
-- procedure are added in order after the current directory and before the -- procedure are added in order after the current directory and before the
-- path given by the environment variable GPR_PROJECT_PATH. A value of "-" -- path given by the environment variable GPR_PROJECT_PATH. A value of "-"
......
gcc/ada/s-rident.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -382,10 +382,11 @@ package System.Rident is ...@@ -382,10 +382,11 @@ package System.Rident is
-- value of the parameter permitted by the profile. -- value of the parameter permitted by the profile.
end record; 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 => -- No_Implementation_Extensions profile
-- Restrictions for Restricted profile
No_Implementation_Extensions =>
(Set => (Set =>
(No_Implementation_Aspect_Specifications => True, (No_Implementation_Aspect_Specifications => True,
......
gcc/ada/sem_util.adb
...@@ -1242,7 +1242,8 @@ package body Sem_Util is ...@@ -1242,7 +1242,8 @@ package body Sem_Util is
-- Return the entity associated with the function call -- Return the entity associated with the function call
procedure Preanalyze_Without_Errors (N : Node_Id); 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 -- -- Collect_Identifiers --
...@@ -1273,11 +1274,9 @@ package body Sem_Util is ...@@ -1273,11 +1274,9 @@ package body Sem_Util is
if No (Entity (N)) then if No (Entity (N)) then
return Skip; return Skip;
-- We don't collect identifiers of packages, called functions, -- Don't collect identifiers of packages, called functions, etc
-- etc.
elsif Ekind_In (Entity (N), elsif Ekind_In (Entity (N), E_Package,
E_Package,
E_Function, E_Function,
E_Procedure, E_Procedure,
E_Entry) E_Entry)
...@@ -1350,21 +1349,22 @@ package body Sem_Util is ...@@ -1350,21 +1349,22 @@ package body Sem_Util is
pragma Assert (Nkind (N) in N_Has_Entity); pragma Assert (Nkind (N) in N_Has_Entity);
Elmt : Elmt_Id; Elmt : Elmt_Id;
begin begin
if List = No_Elist then if List = No_Elist then
return False; return False;
end if; end if;
Elmt := First_Elmt (List); Elmt := First_Elmt (List);
loop while Present (Elmt) loop
if No (Elmt) then if Entity (Node (Elmt)) = Entity (N) then
return False;
elsif Entity (Node (Elmt)) = Entity (N) then
return True; return True;
else else
Next_Elmt (Elmt); Next_Elmt (Elmt);
end if; end if;
end loop; end loop;
return False;
end Contains; end Contains;
------------------ ------------------
...@@ -1397,6 +1397,7 @@ package body Sem_Util is ...@@ -1397,6 +1397,7 @@ package body Sem_Util is
function Get_Function_Id (Call : Node_Id) return Entity_Id is function Get_Function_Id (Call : Node_Id) return Entity_Id is
Nam : constant Node_Id := Name (Call); Nam : constant Node_Id := Name (Call);
Id : Entity_Id; Id : Entity_Id;
begin begin
if Nkind (Nam) = N_Explicit_Dereference then if Nkind (Nam) = N_Explicit_Dereference then
Id := Etype (Nam); Id := Etype (Nam);
...@@ -1433,8 +1434,7 @@ package body Sem_Util is ...@@ -1433,8 +1434,7 @@ package body Sem_Util is
if Ada_Version < Ada_2012 if Ada_Version < Ada_2012
or else (not (Nkind (N) in N_Op) or else (not (Nkind (N) in N_Op)
and then not (Nkind (N) in N_Membership_Test) and then not (Nkind (N) in N_Membership_Test)
and then not Nkind_In (N, and then not Nkind_In (N, N_Range,
N_Range,
N_Aggregate, N_Aggregate,
N_Extension_Aggregate, N_Extension_Aggregate,
N_Full_Type_Declaration, N_Full_Type_Declaration,
...@@ -1502,6 +1502,7 @@ package body Sem_Util is ...@@ -1502,6 +1502,7 @@ package body Sem_Util is
Comp : Node_Id; Comp : Node_Id;
Def_Id : Entity_Id := Defining_Identifier (N); Def_Id : Entity_Id := Defining_Identifier (N);
Rec : Node_Id := Get_Record_Part (N); Rec : Node_Id := Get_Record_Part (N);
begin begin
-- No need to perform any analysis if the record has no -- No need to perform any analysis if the record has no
-- components -- components
...@@ -1650,9 +1651,8 @@ package body Sem_Util is ...@@ -1650,9 +1651,8 @@ package body Sem_Util is
end loop; end loop;
Num_Components := Num_Components :=
Expr_Value (High_Bound (Aggregate_Bounds (N))) Expr_Value (High_Bound (Aggregate_Bounds (N))) -
- Expr_Value (Low_Bound (Aggregate_Bounds (N))) Expr_Value (Low_Bound (Aggregate_Bounds (N))) + 1;
+ 1;
pragma Assert (Count_Components <= Num_Components); pragma Assert (Count_Components <= Num_Components);
...@@ -1735,8 +1735,7 @@ package body Sem_Util is ...@@ -1735,8 +1735,7 @@ package body Sem_Util is
if Nkind (Choice) in N_Has_Entity if Nkind (Choice) in N_Has_Entity
and then Present (Entity (Choice)) and then Present (Entity (Choice))
and then Ekind (Entity (Choice)) and then Ekind (Entity (Choice)) = E_Discriminant
= E_Discriminant
then then
null; null;
......
gcc/ada/sprint.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -70,7 +70,10 @@ package body Sprint is ...@@ -70,7 +70,10 @@ package body Sprint is
-- or for Print_Generated_Code (-gnatG) or Dump_Generated_Code (-gnatD). -- or for Print_Generated_Code (-gnatG) or Dump_Generated_Code (-gnatD).
Dump_Freeze_Null : Boolean; 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; Freeze_Indent : Int := 0;
-- Keep track of freeze indent level (controls output of blank lines before -- Keep track of freeze indent level (controls output of blank lines before
...@@ -1827,7 +1830,15 @@ package body Sprint is ...@@ -1827,7 +1830,15 @@ package body Sprint is
if Dump_Original_Only then if Dump_Original_Only then
null; 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_Indent;
Write_Rewrite_Str ("<<<"); Write_Rewrite_Str ("<<<");
Write_Str_With_Col_Check_Sloc ("freeze "); Write_Str_With_Col_Check_Sloc ("freeze ");
...@@ -4084,7 +4095,7 @@ package body Sprint is ...@@ -4084,7 +4095,7 @@ package body Sprint is
when E_Modular_Integer_Type => when E_Modular_Integer_Type =>
Write_Header; Write_Header;
Write_Str (" mod "); Write_Str ("mod ");
Write_Uint_With_Col_Check (Modulus (Typ), Auto); Write_Uint_With_Col_Check (Modulus (Typ), Auto);
-- Floating point types and subtypes -- Floating point types and subtypes
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment