This patch implements delay of all aspects till the freeze point
as finally decided in the Ada 2012 design. It also corrects a
couple of errors in handling delayed aspects (now that we have
many more of them, these errors showed up).
Here is a test program (compiled with -gnatws)
1. pragma Ada_2012;
2. with Ada.Text_IO; use Ada.Text_IO;
3. procedure DelayAllAspect is
4. Outer_X : constant Integer := 8;
5. Outer_Y : constant Integer := 8;
6.
7. package X1 is
8. type X1T is range 1 .. 2 with
9. Size => Outer_X;
10. Outer_X : constant Integer := 16;
11. end;
12.
13. package X2 is
14. type X2T is range 1 .. 2 with
15. Size => Outer_X;
16. V2T : X2T; -- freezes
17. Outer_X : constant Integer := 16;
18. -- Should give error!
19. end X2;
20.
21. package X3 is
22. type X3T is range 1 .. 2 with
23. Size => Outer_X + Outer_Y;
24. Outer_Y : constant Integer := 24;
25. V3T : X3T; -- freezes
26. Outer_X : constant Integer := 40;
27. -- Should give error!
28. end X3;
29.
30. begin
31. Put_Line (X1.X1T'Size'Img & " should be 16");
32. Put_Line (X2.X2T'Size'Img & " should be 8");
33. Put_Line (X3.X3T'Size'Img & " should be 32");
34. end DelayAllAspect;
The output with this patch is:
16 should be 16
8 should be 8
32 should be 32
Note the two lines marked "Should give error", These reflect
the requirement under discussion that if the freeze point is
before the end of the declarative region, and the visibility
changes between the freeze point and the end of this region,
the program is illegal.
This seems very hard to do, and we will wait on this till
(a) the final decision is to go in this direction and
(b) we figure out how the heck to implement this (sees
awfully difficult).
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-08-01 Robert Dewar <de...@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.
Index: sinfo.adb
===================================================================
--- sinfo.adb (revision 176998)
+++ sinfo.adb (working copy)
@@ -1696,6 +1696,14 @@
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 @@
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
Index: sinfo.ads
===================================================================
--- sinfo.ads (revision 176998)
+++ sinfo.ads (working copy)
@@ -1252,6 +1252,10 @@
-- 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 @@
-- 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 @@
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 @@
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 @@
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 @@
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);
Index: freeze.adb
===================================================================
--- freeze.adb (revision 176998)
+++ freeze.adb (working copy)
@@ -2370,24 +2370,58 @@
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;
Index: exp_ch13.adb
===================================================================
--- exp_ch13.adb (revision 176998)
+++ exp_ch13.adb (working copy)
@@ -232,9 +232,13 @@
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 @@
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);
Index: aspects.ads
===================================================================
--- aspects.ads (revision 176998)
+++ aspects.ads (working copy)
@@ -43,51 +43,56 @@
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 @@
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 @@
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);
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 176998)
+++ sem_ch13.adb (working copy)
@@ -740,7 +740,6 @@
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 @@
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 @@
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,31 +845,18 @@
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 =>
+ Aspect_Value_Size |
+ Aspect_Write =>
- -- 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);
-
-- Construct the attribute definition clause
Aitem :=
@@ -913,16 +865,9 @@
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 @@
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 @@
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 @@
-- 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,
