OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2011-08-01  Robert Dewar  <dewar@adacore.com>

	* aspects.ads (Boolean_Aspects): New subtype.
	* exp_ch13.adb (Expand_Freeze_Entity): Fix errors in handling aspects
	for derived types in cases where the parent type and derived type have
	aspects.
	* freeze.adb (Freeze_Entity): Fix problems in handling derived type
	with aspects when parent type also has aspects.
	(Freeze_Entity): Deal with delay of boolean aspects (must evaluate
	boolean expression at this point).
	* sem_ch13.adb (Analyze_Aspect_Specifications): Delay all aspects in
	accordance with final decision on the Ada 2012 feature.
	* sinfo.ads, sinfo.adb (Is_Boolean_Aspect): New flag.

2011-08-01  Matthew Heaney  <heaney@adacore.com>

	* a-chtgbo.adb (Delete_Node_Sans_Free): Replace iterator with selector.

From-SVN: r177005
This commit is contained in:
Arnaud Charlet 2011-08-01 11:25:46 +02:00
parent 060a3f289f
commit 6bb8853384
8 changed files with 149 additions and 146 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
gcc/ada/ChangeLog
View File

@ -1,3 +1,21 @@
2011-08-01 Robert Dewar <dewar@adacore.com>
* aspects.ads (Boolean_Aspects): New subtype.
* exp_ch13.adb (Expand_Freeze_Entity): Fix errors in handling aspects
for derived types in cases where the parent type and derived type have
aspects.
* freeze.adb (Freeze_Entity): Fix problems in handling derived type
with aspects when parent type also has aspects.
(Freeze_Entity): Deal with delay of boolean aspects (must evaluate
boolean expression at this point).
* sem_ch13.adb (Analyze_Aspect_Specifications): Delay all aspects in
accordance with final decision on the Ada 2012 feature.
* sinfo.ads, sinfo.adb (Is_Boolean_Aspect): New flag.
2011-08-01 Matthew Heaney <heaney@adacore.com>
* a-chtgbo.adb (Delete_Node_Sans_Free): Replace iterator with selector.
2011-08-01 Pascal Obry <obry@adacore.com>
* a-stzunb-shared.adb, a-strunb-shared.adb, a-stwiun-shared.adb:

6
gcc/ada/a-chtgbo.adb
View File

@ -78,7 +78,7 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Operations is
end if;
if Prev = X then
HT.Buckets (Indx) := Next (HT, Prev);
HT.Buckets (Indx) := Next (HT.Nodes (Prev));
HT.Length := HT.Length - 1;
return;
end if;
@ -89,7 +89,7 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Operations is
end if;
loop
Curr := Next (HT, Prev);
Curr := Next (HT.Nodes (Prev));
if Curr = 0 then
raise Program_Error with
@ -97,7 +97,7 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Operations is
end if;
if Curr = X then
Set_Next (HT.Nodes (Prev), Next => Next (HT, Curr));
Set_Next (HT.Nodes (Prev), Next => Next (HT.Nodes (Curr)));
HT.Length := HT.Length - 1;
return;
end if;

80
gcc/ada/aspects.ads
View File

@ -43,51 +43,56 @@ package Aspects is
type Aspect_Id is
(No_Aspect, -- Dummy entry for no aspect
Aspect_Ada_2005, -- GNAT
Aspect_Ada_2012, -- GNAT
Aspect_Address,
Aspect_Alignment,
Aspect_Atomic,
Aspect_Atomic_Components,
Aspect_Bit_Order,
Aspect_Component_Size,
Aspect_Discard_Names,
Aspect_External_Tag,
Aspect_Favor_Top_Level, -- GNAT
Aspect_Inline,
Aspect_Inline_Always, -- GNAT
Aspect_Input,
Aspect_Invariant,
Aspect_Machine_Radix,
Aspect_No_Return,
Aspect_Object_Size, -- GNAT
Aspect_Output,
Aspect_Pack,
Aspect_Persistent_BSS, -- GNAT
Aspect_Post,
Aspect_Pre,
Aspect_Predicate, -- GNAT???
Aspect_Preelaborable_Initialization,
Aspect_Pure_Function, -- GNAT
Aspect_Predicate,
Aspect_Read,
Aspect_Shared, -- GNAT (equivalent to Atomic)
Aspect_Size,
Aspect_Storage_Pool,
Aspect_Storage_Size,
Aspect_Stream_Size,
Aspect_Suppress,
Aspect_Unsuppress,
Aspect_Value_Size, -- GNAT
Aspect_Warnings,
Aspect_Write,
-- Remaining aspects have a static boolean value that turns the aspect
-- on or off. They all correspond to pragmas, and the flag Aspect_Cancel
-- is set on the pragma if the corresponding aspect is False.
Aspect_Ada_2005, -- GNAT
Aspect_Ada_2012, -- GNAT
Aspect_Atomic,
Aspect_Atomic_Components,
Aspect_Discard_Names,
Aspect_Favor_Top_Level, -- GNAT
Aspect_Inline,
Aspect_Inline_Always, -- GNAT
Aspect_No_Return,
Aspect_Pack,
Aspect_Persistent_BSS, -- GNAT
Aspect_Preelaborable_Initialization,
Aspect_Pure_Function, -- GNAT
Aspect_Shared, -- GNAT (equivalent to Atomic)
Aspect_Suppress_Debug_Info, -- GNAT
Aspect_Unchecked_Union,
Aspect_Universal_Aliasing, -- GNAT
Aspect_Unmodified, -- GNAT
Aspect_Unreferenced, -- GNAT
Aspect_Unreferenced_Objects, -- GNAT
Aspect_Unsuppress,
Aspect_Value_Size, -- GNAT
Aspect_Volatile,
Aspect_Volatile_Components,
Aspect_Warnings,
Aspect_Write); -- GNAT
Aspect_Volatile_Components);
-- The following array indicates aspects that accept 'Class
@ -98,6 +103,16 @@ package Aspects is
Aspect_Post => True,
others => False);
-- The following subtype defines aspects accepting an optional static
-- boolean parameter indicating if the aspect should be active or
-- cancelling. If the parameter is missing the effective value is True,
-- enabling the aspect. If the parameter is present it must be a static
-- expression of type Standard.Boolean. If the value is True, then the
-- aspect is enabled. If it is False, the aspect is disabled.
subtype Boolean_Aspects is
Aspect_Id range Aspect_Ada_2005 .. Aspect_Id'Last;
-- The following type is used for indicating allowed expression forms
type Aspect_Expression is
@ -109,51 +124,30 @@ package Aspects is
Aspect_Argument : constant array (Aspect_Id) of Aspect_Expression :=
(No_Aspect => Optional,
Aspect_Ada_2005 => Optional,
Aspect_Ada_2012 => Optional,
Aspect_Address => Expression,
Aspect_Alignment => Expression,
Aspect_Atomic => Optional,
Aspect_Atomic_Components => Optional,
Aspect_Bit_Order => Expression,
Aspect_Component_Size => Expression,
Aspect_Discard_Names => Optional,
Aspect_External_Tag => Expression,
Aspect_Favor_Top_Level => Optional,
Aspect_Inline => Optional,
Aspect_Inline_Always => Optional,
Aspect_Input => Name,
Aspect_Invariant => Expression,
Aspect_Machine_Radix => Expression,
Aspect_No_Return => Optional,
Aspect_Object_Size => Expression,
Aspect_Output => Name,
Aspect_Persistent_BSS => Optional,
Aspect_Pack => Optional,
Aspect_Post => Expression,
Aspect_Pre => Expression,
Aspect_Predicate => Expression,
Aspect_Preelaborable_Initialization => Optional,
Aspect_Pure_Function => Optional,
Aspect_Read => Name,
Aspect_Shared => Optional,
Aspect_Size => Expression,
Aspect_Storage_Pool => Name,
Aspect_Storage_Size => Expression,
Aspect_Stream_Size => Expression,
Aspect_Suppress => Name,
Aspect_Suppress_Debug_Info => Optional,
Aspect_Unchecked_Union => Optional,
Aspect_Universal_Aliasing => Optional,
Aspect_Unmodified => Optional,
Aspect_Unreferenced => Optional,
Aspect_Unreferenced_Objects => Optional,
Aspect_Unsuppress => Name,
Aspect_Value_Size => Expression,
Aspect_Volatile => Optional,
Aspect_Volatile_Components => Optional,
Aspect_Warnings => Name,
Aspect_Write => Name);
Aspect_Write => Name,
Boolean_Aspects => Optional);
function Get_Aspect_Id (Name : Name_Id) return Aspect_Id;
pragma Inline (Get_Aspect_Id);

8
gcc/ada/exp_ch13.adb
View File

@ -232,9 +232,13 @@ package body Exp_Ch13 is
Ritem : Node_Id;
begin
-- Look for aspect specs for this entity
Ritem := First_Rep_Item (E);
while Present (Ritem) loop
if Nkind (Ritem) = N_Aspect_Specification then
if Nkind (Ritem) = N_Aspect_Specification
and then Entity (Ritem) = E
then
Aitem := Aspect_Rep_Item (Ritem);
pragma Assert (Is_Delayed_Aspect (Aitem));
Insert_Before (N, Aitem);
@ -288,7 +292,7 @@ package body Exp_Ch13 is
if Ekind (E_Scope) = E_Protected_Type
or else (Ekind (E_Scope) = E_Task_Type
and then not Has_Completion (E_Scope))
and then not Has_Completion (E_Scope))
then
E_Scope := Scope (E_Scope);

42
gcc/ada/freeze.adb
View File

@ -2370,24 +2370,58 @@ package body Freeze is
end;
end if;
-- Deal with delayed aspect specifications. At the point of occurrence
-- of the aspect definition, we preanalyzed the argument, to capture
-- the visibility at that point, but the actual analysis of the aspect
-- Deal with delayed aspect specifications. The analysis of the aspect
-- is required to be delayed to the freeze point, so we evaluate the
-- pragma or attribute definition clause in the tree at this point.
-- We also have to deal with the case of Boolean aspects, where the
-- value of the Boolean expression is represented by the setting of
-- the Aspect_Cancel flag on the pragma.
if Has_Delayed_Aspects (E) then
declare
Ritem : Node_Id;
Aitem : Node_Id;
begin
-- Look for aspect specification entries for this entity
Ritem := First_Rep_Item (E);
while Present (Ritem) loop
if Nkind (Ritem) = N_Aspect_Specification then
if Nkind (Ritem) = N_Aspect_Specification
and then Entity (Ritem) = E
then
Aitem := Aspect_Rep_Item (Ritem);
pragma Assert (Is_Delayed_Aspect (Aitem));
Set_Parent (Aitem, Ritem);
-- Deal with Boolean case, if no expression, True, otherwise
-- analyze the expression, check it is static, and if its
-- value is False, set Aspect_Cancel for the related pragma.
if Is_Boolean_Aspect (Ritem) then
declare
Expr : constant Node_Id := Expression (Ritem);
begin
if Present (Expr) then
Analyze_And_Resolve (Expr, Standard_Boolean);
if not Is_OK_Static_Expression (Expr) then
Error_Msg_Name_1 := Chars (Identifier (Ritem));
Error_Msg_N
("expression for % aspect must be static",
Expr);
elsif Is_False (Expr_Value (Expr)) then
Set_Aspect_Cancel (Aitem);
end if;
end if;
end;
end if;
-- Analyze the pragma after possibly setting Aspect_Cancel
Analyze (Aitem);
end if;

112
gcc/ada/sem_ch13.adb
View File

@ -740,7 +740,6 @@ package body Sem_Ch13 is
Nam : constant Name_Id := Chars (Id);
A_Id : constant Aspect_Id := Get_Aspect_Id (Nam);
Anod : Node_Id;
T : Entity_Id;
Eloc : Source_Ptr := Sloc (Expr);
-- Source location of expression, modified when we split PPC's
@ -811,31 +810,12 @@ package body Sem_Ch13 is
raise Program_Error;
-- Aspects taking an optional boolean argument. For all of
-- these we just create a matching pragma and insert it,
-- setting flag Cancel_Aspect if the expression is False.
-- these we just create a matching pragma and insert it. When
-- the aspect is processed to insert the pragma, the expression
-- is analyzed, setting Cancel_Aspect if the value is False.
when Aspect_Ada_2005 |
Aspect_Ada_2012 |
Aspect_Atomic |
Aspect_Atomic_Components |
Aspect_Discard_Names |
Aspect_Favor_Top_Level |
Aspect_Inline |
Aspect_Inline_Always |
Aspect_No_Return |
Aspect_Pack |
Aspect_Persistent_BSS |
Aspect_Preelaborable_Initialization |
Aspect_Pure_Function |
Aspect_Shared |
Aspect_Suppress_Debug_Info |
Aspect_Unchecked_Union |
Aspect_Universal_Aliasing |
Aspect_Unmodified |
Aspect_Unreferenced |
Aspect_Unreferenced_Objects |
Aspect_Volatile |
Aspect_Volatile_Components =>
when Boolean_Aspects =>
Set_Is_Boolean_Aspect (Aspect);
-- Build corresponding pragma node
@ -845,32 +825,17 @@ package body Sem_Ch13 is
Pragma_Identifier =>
Make_Identifier (Sloc (Id), Chars (Id)));
-- Deal with missing expression case, delay never needed
-- No delay required if no expression (nothing to delay!)
if No (Expr) then
Delay_Required := False;
-- Expression is present
-- Expression is present, delay is required. Note that
-- even if the expression is "True", some idiot might
-- define True as False before the freeze point!
else
Preanalyze_Spec_Expression (Expr, Standard_Boolean);
-- If preanalysis gives a static expression, we don't
-- need to delay (this will happen often in practice).
if Is_OK_Static_Expression (Expr) then
Delay_Required := False;
if Is_False (Expr_Value (Expr)) then
Set_Aspect_Cancel (Aitem);
end if;
-- If we don't get a static expression, then delay, the
-- expression may turn out static by freeze time.
else
Delay_Required := True;
end if;
Delay_Required := True;
end if;
-- Aspects corresponding to attribute definition clauses
@ -880,30 +845,17 @@ package body Sem_Ch13 is
Aspect_Bit_Order |
Aspect_Component_Size |
Aspect_External_Tag |
Aspect_Input |
Aspect_Machine_Radix |
Aspect_Object_Size |
Aspect_Output |
Aspect_Read |
Aspect_Size |
Aspect_Storage_Pool |
Aspect_Storage_Size |
Aspect_Stream_Size |
Aspect_Value_Size =>
-- Preanalyze the expression with the appropriate type
case A_Id is
when Aspect_Address =>
T := RTE (RE_Address);
when Aspect_Bit_Order =>
T := RTE (RE_Bit_Order);
when Aspect_External_Tag =>
T := Standard_String;
when Aspect_Storage_Pool =>
T := Class_Wide_Type (RTE (RE_Root_Storage_Pool));
when others =>
T := Any_Integer;
end case;
Preanalyze_Spec_Expression (Expr, T);
Aspect_Value_Size |
Aspect_Write =>
-- Construct the attribute definition clause
@ -913,16 +865,9 @@ package body Sem_Ch13 is
Chars => Chars (Id),
Expression => Relocate_Node (Expr));
-- We do not need a delay if we have a static expression
if Is_OK_Static_Expression (Expression (Aitem)) then
Delay_Required := False;
-- Here a delay is required
else
Delay_Required := True;
end if;
Delay_Required := True;
-- Aspects corresponding to pragmas with two arguments, where
-- the first argument is a local name referring to the entity,
@ -946,27 +891,6 @@ package body Sem_Ch13 is
Delay_Required := False;
-- Aspects corresponding to stream routines
when Aspect_Input |
Aspect_Output |
Aspect_Read |
Aspect_Write =>
-- Construct the attribute definition clause
Aitem :=
Make_Attribute_Definition_Clause (Loc,
Name => Ent,
Chars => Chars (Id),
Expression => Relocate_Node (Expr));
-- These are always delayed (typically the subprogram that
-- is referenced cannot have been declared yet, since it has
-- a reference to the type for which this aspect is defined.
Delay_Required := True;
-- Aspects corresponding to pragmas with two arguments, where
-- the second argument is a local name referring to the entity,
-- and the first argument is the aspect definition expression.
@ -985,7 +909,7 @@ package body Sem_Ch13 is
Class_Present => Class_Present (Aspect));
-- We don't have to play the delay game here, since the only
-- values are check names which don't get analyzed anyway.
-- values are ON/OFF which don't get analyzed anyway.
Delay_Required := False;
@ -1015,7 +939,7 @@ package body Sem_Ch13 is
-- these conditions together in a complex OR expression
if Pname = Name_Postcondition
or else not Class_Present (Aspect)
or else not Class_Present (Aspect)
then
while Nkind (Expr) = N_And_Then loop
Insert_After (Aspect,

16
gcc/ada/sinfo.adb
View File

@ -1696,6 +1696,14 @@ package body Sinfo is
return Flag7 (N);
end Is_Asynchronous_Call_Block;
function Is_Boolean_Aspect
(N : Node_Id) return Boolean is
begin
pragma Assert (False
or else NT (N).Nkind = N_Aspect_Specification);
return Flag16 (N);
end Is_Boolean_Aspect;
function Is_Component_Left_Opnd
(N : Node_Id) return Boolean is
begin
@ -4716,6 +4724,14 @@ package body Sinfo is
Set_Flag7 (N, Val);
end Set_Is_Asynchronous_Call_Block;
procedure Set_Is_Boolean_Aspect
(N : Node_Id; Val : Boolean := True) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Aspect_Specification);
Set_Flag16 (N, Val);
end Set_Is_Boolean_Aspect;
procedure Set_Is_Component_Left_Opnd
(N : Node_Id; Val : Boolean := True) is
begin

13
gcc/ada/sinfo.ads
View File

@ -1252,6 +1252,10 @@ package Sinfo is
-- expansion of an asynchronous entry call. Such a block needs cleanup
-- handler to assure that the call is cancelled.
-- Is_Boolean_Aspect (Flag16-Sem)
-- Present in N_Aspect_Specification node. Set if the aspect is for a
-- boolean aspect (i.e. Aspect_Id is in Boolean_Aspect subtype).
-- Is_Component_Left_Opnd (Flag13-Sem)
-- Is_Component_Right_Opnd (Flag14-Sem)
-- Present in concatenation nodes, to indicate that the corresponding
@ -6543,6 +6547,7 @@ package Sinfo is
-- Class_Present (Flag6) Set if 'Class present
-- Next_Rep_Item (Node5-Sem)
-- Split_PPC (Flag17) Set if split pre/post attribute
-- Is_Boolean_Aspect (Flag16-Sem)
-- Note: Aspect_Specification is an Ada 2012 feature
@ -8487,6 +8492,9 @@ package Sinfo is
function Is_Asynchronous_Call_Block
(N : Node_Id) return Boolean; -- Flag7
function Is_Boolean_Aspect
(N : Node_Id) return Boolean; -- Flag16
function Is_Component_Left_Opnd
(N : Node_Id) return Boolean; -- Flag13
@ -9450,6 +9458,9 @@ package Sinfo is
procedure Set_Is_Asynchronous_Call_Block
(N : Node_Id; Val : Boolean := True); -- Flag7
procedure Set_Is_Boolean_Aspect
(N : Node_Id; Val : Boolean := True); -- Flag16
procedure Set_Is_Component_Left_Opnd
(N : Node_Id; Val : Boolean := True); -- Flag13
@ -11793,6 +11804,7 @@ package Sinfo is
pragma Inline (Iterator_Specification);
pragma Inline (Is_Accessibility_Actual);
pragma Inline (Is_Asynchronous_Call_Block);
pragma Inline (Is_Boolean_Aspect);
pragma Inline (Is_Component_Left_Opnd);
pragma Inline (Is_Component_Right_Opnd);
pragma Inline (Is_Controlling_Actual);
@ -12110,6 +12122,7 @@ package Sinfo is
pragma Inline (Set_Iterator_Specification);
pragma Inline (Set_Is_Accessibility_Actual);
pragma Inline (Set_Is_Asynchronous_Call_Block);
pragma Inline (Set_Is_Boolean_Aspect);
pragma Inline (Set_Is_Component_Left_Opnd);
pragma Inline (Set_Is_Component_Right_Opnd);
pragma Inline (Set_Is_Controlling_Actual);