===================================================================
@@ -23,7 +23,6 @@
-- --
------------------------------------------------------------------------------
-with Aspects; use Aspects;
with Atree; use Atree;
with Checks; use Checks;
with Debug; use Debug;
@@ -2016,7 +2015,10 @@
end if;
Set_Original_Record_Component (Id, Id);
- Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
end Analyze_Component_Declaration;
--------------------------
@@ -2491,7 +2493,9 @@
Set_Optimize_Alignment_Flags (Def_Id);
Check_Eliminated (Def_Id);
- Analyze_Aspect_Specifications (N, Def_Id, Aspect_Specifications (N));
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Def_Id);
+ end if;
end Analyze_Full_Type_Declaration;
----------------------------------
@@ -3704,7 +3708,9 @@
end if;
<<Leave>>
- Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
end Analyze_Object_Declaration;
---------------------------
@@ -3943,8 +3949,10 @@
end if;
end if;
- <<Leave>>
- Analyze_Aspect_Specifications (N, T, Aspect_Specifications (N));
+ <<Leave>>
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, T);
+ end if;
end Analyze_Private_Extension_Declaration;
---------------------------------
@@ -4413,7 +4421,9 @@
Check_Eliminated (Id);
<<Leave>>
- Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
end Analyze_Subtype_Declaration;
--------------------------------
===================================================================
@@ -256,14 +256,6 @@
return Node3 (N);
end Array_Aggregate;
- function Aspect_Cancel
- (N : Node_Id) return Boolean is
- begin
- pragma Assert (False
- or else NT (N).Nkind = N_Pragma);
- return Flag11 (N);
- end Aspect_Cancel;
-
function Aspect_Rep_Item
(N : Node_Id) return Node_Id is
begin
@@ -3317,14 +3309,6 @@
Set_Node3_With_Parent (N, Val);
end Set_Array_Aggregate;
- procedure Set_Aspect_Cancel
- (N : Node_Id; Val : Boolean := True) is
- begin
- pragma Assert (False
- or else NT (N).Nkind = N_Pragma);
- Set_Flag11 (N, Val);
- end Set_Aspect_Cancel;
-
procedure Set_Aspect_Rep_Item
(N : Node_Id; Val : Node_Id) is
begin
===================================================================
@@ -584,14 +584,6 @@
-- is used for translation of the at end handler into a normal exception
-- handler.
- -- Aspect_Cancel (Flag11-Sem)
- -- Processing of aspect specifications typically generates pragmas and
- -- attribute definition clauses that are inserted into the tree after
- -- the declaration node to get the desired aspect effect. In the case
- -- of Boolean aspects that use "=> False" to cancel the effect of an
- -- aspect (i.e. turn if off), the generated pragma has the Aspect_Cancel
- -- flag set to indicate that the pragma operates in the opposite sense.
-
-- Aspect_Rep_Item (Node2-Sem)
-- Present in N_Aspect_Specification nodes. Points to the corresponding
-- pragma/attribute definition node used to process the aspect.
@@ -2085,7 +2077,6 @@
-- From_Aspect_Specification (Flag13-Sem)
-- Is_Delayed_Aspect (Flag14-Sem)
-- Import_Interface_Present (Flag16-Sem)
- -- Aspect_Cancel (Flag11-Sem)
-- Split_PPC (Flag17) set if corresponding aspect had Split_PPC set
-- Class_Present (Flag6) set if from Aspect with 'Class
-- From_Dynamic_Predicate (Flag7-Sem) Set if Dynamic_Predicate aspect
@@ -8076,9 +8067,6 @@
function Array_Aggregate
(N : Node_Id) return Node_Id; -- Node3
- function Aspect_Cancel
- (N : Node_Id) return Boolean; -- Flag11
-
function Aspect_Rep_Item
(N : Node_Id) return Node_Id; -- Node2
@@ -9054,9 +9042,6 @@
procedure Set_Array_Aggregate
(N : Node_Id; Val : Node_Id); -- Node3
- procedure Set_Aspect_Cancel
- (N : Node_Id; Val : Boolean := True); -- Flag11
-
procedure Set_Aspect_Rep_Item
(N : Node_Id; Val : Node_Id); -- Node2
@@ -11709,7 +11694,6 @@
pragma Inline (Alternatives);
pragma Inline (Ancestor_Part);
pragma Inline (Array_Aggregate);
- pragma Inline (Aspect_Cancel);
pragma Inline (Aspect_Rep_Item);
pragma Inline (Assignment_OK);
pragma Inline (Associated_Node);
@@ -12032,7 +12016,6 @@
pragma Inline (Set_Alternatives);
pragma Inline (Set_Ancestor_Part);
pragma Inline (Set_Array_Aggregate);
- pragma Inline (Set_Aspect_Cancel);
pragma Inline (Set_Aspect_Rep_Item);
pragma Inline (Set_Assignment_OK);
pragma Inline (Set_Associated_Node);
===================================================================
@@ -28,7 +28,6 @@
-- handling of private and full declarations, and the construction of dispatch
-- tables for tagged types.
-with Aspects; use Aspects;
with Atree; use Atree;
with Debug; use Debug;
with Einfo; use Einfo;
@@ -763,7 +762,9 @@
-- Analye aspect specifications immediately, since we need to recognize
-- things like Pure early enough to diagnose violations during analysis.
- Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
-- Ada 2005 (AI-217): Check if the package has been erroneously named
-- in a limited-with clause of its own context. In this case the error
@@ -1405,7 +1406,10 @@
New_Private_Type (N, Id, N);
Set_Depends_On_Private (Id);
- Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
end Analyze_Private_Type_Declaration;
----------------------------------
===================================================================
@@ -976,7 +976,10 @@
end if;
Generate_Reference_To_Formals (Def_Id);
- Analyze_Aspect_Specifications (N, Def_Id, Aspect_Specifications (N));
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Def_Id);
+ end if;
end Analyze_Entry_Declaration;
---------------------------------------
@@ -1336,8 +1339,10 @@
end if;
end if;
- <<Leave>>
- Analyze_Aspect_Specifications (N, Def_Id, Aspect_Specifications (N));
+ <<Leave>>
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Def_Id);
+ end if;
end Analyze_Protected_Type_Declaration;
---------------------
@@ -1806,7 +1811,10 @@
-- disastrous result.
Analyze_Protected_Type_Declaration (N);
- Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
end Analyze_Single_Protected_Declaration;
-------------------------------------
@@ -1873,7 +1881,10 @@
-- disastrous result.
Analyze_Task_Type_Declaration (N);
- Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
end Analyze_Single_Task_Declaration;
-----------------------
@@ -2152,7 +2163,9 @@
end if;
end if;
- Analyze_Aspect_Specifications (N, Def_Id, Aspect_Specifications (N));
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Def_Id);
+ end if;
end Analyze_Task_Type_Declaration;
-----------------------------------
===================================================================
@@ -270,13 +270,6 @@
Pname : constant Name_Id := Pragma_Name (N);
Prag_Id : Pragma_Id;
- Sense : constant Boolean := not Aspect_Cancel (N);
- -- Sense is True if we have the normal case of a pragma that is active
- -- and turns the corresponding aspect on. It is false only for the case
- -- of a pragma coming from an aspect which is explicitly turned off by
- -- using aspect => False. If Sense is False, the effect of the pragma
- -- is to turn the corresponding aspect off.
-
Pragma_Exit : exception;
-- This exception is used to exit pragma processing completely. It is
-- used when an error is detected, and no further processing is
@@ -2461,9 +2454,9 @@
procedure Set_Atomic (E : Entity_Id) is
begin
- Set_Is_Atomic (E, Sense);
+ Set_Is_Atomic (E);
- if Sense and then not Has_Alignment_Clause (E) then
+ if not Has_Alignment_Clause (E) then
Set_Alignment (E, Uint_0);
end if;
end Set_Atomic;
@@ -2510,11 +2503,11 @@
-- Attribute belongs on the base type. If the view of the type is
-- currently private, it also belongs on the underlying type.
- Set_Is_Volatile (Base_Type (E), Sense);
- Set_Is_Volatile (Underlying_Type (E), Sense);
+ Set_Is_Volatile (Base_Type (E));
+ Set_Is_Volatile (Underlying_Type (E));
- Set_Treat_As_Volatile (E, Sense);
- Set_Treat_As_Volatile (Underlying_Type (E), Sense);
+ Set_Treat_As_Volatile (E);
+ Set_Treat_As_Volatile (Underlying_Type (E));
elsif K = N_Object_Declaration
or else (K = N_Component_Declaration
@@ -2525,7 +2518,7 @@
end if;
if Prag_Id /= Pragma_Volatile then
- Set_Is_Atomic (E, Sense);
+ Set_Is_Atomic (E);
-- If the object declaration has an explicit initialization, a
-- temporary may have to be created to hold the expression, to
@@ -2533,7 +2526,6 @@
if Nkind (Parent (E)) = N_Object_Declaration
and then Present (Expression (Parent (E)))
- and then Sense
then
Set_Has_Delayed_Freeze (E);
end if;
@@ -2554,7 +2546,7 @@
Get_Source_File_Index (Sloc (E)) =
Get_Source_File_Index (Sloc (Underlying_Type (Etype (E))))
then
- Set_Is_Atomic (Underlying_Type (Etype (E)), Sense);
+ Set_Is_Atomic (Underlying_Type (Etype (E)));
end if;
end if;
@@ -4155,7 +4147,10 @@
Subp_Id : Node_Id;
Subp : Entity_Id;
Applies : Boolean;
+
Effective : Boolean := False;
+ -- Set True if inline has some effect, i.e. if there is at least one
+ -- subprogram set as inlined as a result of the use of the pragma.
procedure Make_Inline (Subp : Entity_Id);
-- Subp is the defining unit name of the subprogram declaration. Set
@@ -4299,11 +4294,6 @@
-- entity (if declared in the same unit) is inlined.
if Is_Subprogram (Subp) then
-
- if not Sense then
- return;
- end if;
-
Inner_Subp := Ultimate_Alias (Inner_Subp);
if In_Same_Source_Unit (Subp, Inner_Subp) then
@@ -4364,16 +4354,16 @@
procedure Set_Inline_Flags (Subp : Entity_Id) is
begin
if Active then
- Set_Is_Inlined (Subp, Sense);
+ Set_Is_Inlined (Subp);
end if;
if not Has_Pragma_Inline (Subp) then
- Set_Has_Pragma_Inline (Subp, Sense);
+ Set_Has_Pragma_Inline (Subp);
Effective := True;
end if;
if Prag_Id = Pragma_Inline_Always then
- Set_Has_Pragma_Inline_Always (Subp, Sense);
+ Set_Has_Pragma_Inline_Always (Subp);
end if;
end Set_Inline_Flags;
@@ -5846,12 +5836,7 @@
-- Now set appropriate Ada mode
- if Sense then
- Ada_Version := Ada_2005;
- else
- Ada_Version := Ada_Version_Default;
- end if;
-
+ Ada_Version := Ada_2005;
Ada_Version_Explicit := Ada_2005;
end if;
end;
@@ -5899,12 +5884,7 @@
-- Now set appropriate Ada mode
- if Sense then
- Ada_Version := Ada_2012;
- else
- Ada_Version := Ada_Version_Default;
- end if;
-
+ Ada_Version := Ada_2012;
Ada_Version_Explicit := Ada_2012;
end if;
end;
@@ -6378,10 +6358,10 @@
E := Base_Type (E);
end if;
- Set_Has_Volatile_Components (E, Sense);
+ Set_Has_Volatile_Components (E);
if Prag_Id = Pragma_Atomic_Components then
- Set_Has_Atomic_Components (E, Sense);
+ Set_Has_Atomic_Components (E);
end if;
else
@@ -7398,7 +7378,7 @@
-- defined in the current declarative part, and recursively
-- to any nested scope.
- Set_Discard_Names (Current_Scope, Sense);
+ Set_Discard_Names (Current_Scope);
return;
else
@@ -7419,7 +7399,7 @@
(Is_Enumeration_Type (E) or else Is_Tagged_Type (E)))
or else Ekind (E) = E_Exception
then
- Set_Discard_Names (E, Sense);
+ Set_Discard_Names (E);
else
Error_Pragma_Arg
("inappropriate entity for pragma%", Arg1);
@@ -8256,9 +8236,7 @@
-- subtype), set the flag on that type.
if Is_Access_Subprogram_Type (Named_Entity) then
- if Sense then
- Set_Can_Use_Internal_Rep (Named_Entity, False);
- end if;
+ Set_Can_Use_Internal_Rep (Named_Entity, False);
-- Otherwise it's an error (name denotes the wrong sort of entity)
@@ -10928,43 +10906,11 @@
else
if not Ignore then
- Set_Is_Packed (Base_Type (Typ), Sense);
- Set_Has_Non_Standard_Rep (Base_Type (Typ), Sense);
+ Set_Is_Packed (Base_Type (Typ));
+ Set_Has_Non_Standard_Rep (Base_Type (Typ));
end if;
- Set_Has_Pragma_Pack (Base_Type (Typ), Sense);
-
- -- Complete reset action for Aspect_Cancel case
-
- if Sense = False then
-
- -- Cancel size unless explicitly set
-
- if not Has_Size_Clause (Typ)
- and then not Has_Object_Size_Clause (Typ)
- then
- Set_Esize (Typ, Uint_0);
- Set_RM_Size (Typ, Uint_0);
- Set_Alignment (Typ, Uint_0);
- Set_Packed_Array_Type (Typ, Empty);
- end if;
-
- -- Reset component size unless explicitly set
-
- if not Has_Component_Size_Clause (Typ) then
- if Known_Static_Esize (Ctyp)
- and then Known_Static_RM_Size (Ctyp)
- and then Esize (Ctyp) = RM_Size (Ctyp)
- and then Addressable (Esize (Ctyp))
- then
- Set_Component_Size
- (Base_Type (Typ), Esize (Ctyp));
- else
- Set_Component_Size
- (Base_Type (Typ), Uint_0);
- end if;
- end if;
- end if;
+ Set_Has_Pragma_Pack (Base_Type (Typ));
end if;
end if;
@@ -10985,23 +10931,9 @@
-- Normal case of pack request active
else
- Set_Is_Packed (Base_Type (Typ), Sense);
- Set_Has_Pragma_Pack (Base_Type (Typ), Sense);
- Set_Has_Non_Standard_Rep (Base_Type (Typ), Sense);
-
- -- Complete reset action for Aspect_Cancel case
-
- if Sense = False then
-
- -- Cancel size if not explicitly given
-
- if not Has_Size_Clause (Typ)
- and then not Has_Object_Size_Clause (Typ)
- then
- Set_Esize (Typ, Uint_0);
- Set_Alignment (Typ, Uint_0);
- end if;
- end if;
+ Set_Is_Packed (Base_Type (Typ));
+ Set_Has_Pragma_Pack (Base_Type (Typ));
+ Set_Has_Non_Standard_Rep (Base_Type (Typ));
end if;
end if;
end if;
@@ -11145,13 +11077,11 @@
Check_Duplicate_Pragma (Ent);
- if Sense then
- Prag :=
- Make_Linker_Section_Pragma
- (Ent, Sloc (N), ".persistent.bss");
- Insert_After (N, Prag);
- Analyze (Prag);
- end if;
+ Prag :=
+ Make_Linker_Section_Pragma
+ (Ent, Sloc (N), ".persistent.bss");
+ Insert_After (N, Prag);
+ Analyze (Prag);
-- Case of use as configuration pragma with no arguments
@@ -11310,11 +11240,11 @@
if Present (Ent)
and then not (Pk = N_Package_Specification
- and then Present (Generic_Parent (Pa)))
+ and then Present (Generic_Parent (Pa)))
then
if not Debug_Flag_U then
- Set_Is_Preelaborated (Ent, Sense);
- Set_Suppress_Elaboration_Warnings (Ent, Sense);
+ Set_Is_Preelaborated (Ent);
+ Set_Suppress_Elaboration_Warnings (Ent);
end if;
end if;
end Preelaborate;
@@ -11897,11 +11827,11 @@
("pragma% requires a function name", Arg1);
end if;
- Set_Is_Pure (Def_Id, Sense);
+ Set_Is_Pure (Def_Id);
if not Has_Pragma_Pure_Function (Def_Id) then
- Set_Has_Pragma_Pure_Function (Def_Id, Sense);
- Effective := Sense;
+ Set_Has_Pragma_Pure_Function (Def_Id);
+ Effective := True;
end if;
exit when From_Aspect_Specification (N);
@@ -11909,7 +11839,7 @@
exit when No (E) or else Scope (E) /= Current_Scope;
end loop;
- if Sense and then not Effective
+ if not Effective
and then Warn_On_Redundant_Constructs
then
Error_Msg_NE
@@ -12685,7 +12615,7 @@
Check_Arg_Count (1);
Check_Optional_Identifier (Arg1, Name_Entity);
Check_Arg_Is_Local_Name (Arg1);
- Set_Debug_Info_Off (Entity (Get_Pragma_Arg (Arg1)), Sense);
+ Set_Debug_Info_Off (Entity (Get_Pragma_Arg (Arg1)));
----------------------------------
-- Suppress_Exception_Locations --
@@ -13129,14 +13059,10 @@
end loop;
end if;
- Set_Is_Unchecked_Union (Typ, Sense);
-
- if Sense then
- Set_Convention (Typ, Convention_C);
- end if;
-
- Set_Has_Unchecked_Union (Base_Type (Typ), Sense);
- Set_Is_Unchecked_Union (Base_Type (Typ), Sense);
+ Set_Is_Unchecked_Union (Typ);
+ Set_Convention (Typ, Convention_C);
+ Set_Has_Unchecked_Union (Base_Type (Typ));
+ Set_Is_Unchecked_Union (Base_Type (Typ));
end Unchecked_Union;
------------------------
@@ -13195,7 +13121,7 @@
Error_Pragma_Arg ("pragma% requires type", Arg1);
end if;
- Set_Universal_Aliasing (Implementation_Base_Type (E_Id), Sense);
+ Set_Universal_Aliasing (Implementation_Base_Type (E_Id));
end Universal_Alias;
--------------------
@@ -13263,7 +13189,7 @@
("pragma% can only be applied to a variable",
Arg_Expr);
else
- Set_Has_Pragma_Unmodified (Arg_Ent, Sense);
+ Set_Has_Pragma_Unmodified (Arg_Ent);
end if;
end if;
@@ -13358,7 +13284,7 @@
Generate_Reference (Arg_Ent, N);
end if;
- Set_Has_Pragma_Unreferenced (Arg_Ent, Sense);
+ Set_Has_Pragma_Unreferenced (Arg_Ent);
end if;
Next (Arg_Node);
@@ -13393,7 +13319,7 @@
("argument for pragma% must be type or subtype", Arg_Node);
end if;
- Set_Has_Pragma_Unreferenced_Objects (Entity (Arg_Expr), Sense);
+ Set_Has_Pragma_Unreferenced_Objects (Entity (Arg_Expr));
Next (Arg_Node);
end loop;
end Unreferenced_Objects;
===================================================================
@@ -1925,7 +1925,9 @@
end if;
end if;
- Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
end Analyze_Formal_Object_Declaration;
----------------------------------------------
@@ -2280,8 +2282,10 @@
Set_Scope (Pack_Id, Scope (Formal));
Set_Has_Completion (Pack_Id, True);
- <<Leave>>
- Analyze_Aspect_Specifications (N, Pack_Id, Aspect_Specifications (N));
+ <<Leave>>
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Pack_Id);
+ end if;
end Analyze_Formal_Package_Declaration;
---------------------------------
@@ -2501,8 +2505,11 @@
end if;
end if;
- <<Leave>>
- Analyze_Aspect_Specifications (N, Nam, Aspect_Specifications (N));
+ <<Leave>>
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Nam);
+ end if;
+
end Analyze_Formal_Subprogram_Declaration;
-------------------------------------
@@ -2576,7 +2583,10 @@
end case;
Set_Is_Generic_Type (T);
- Analyze_Aspect_Specifications (N, T, Aspect_Specifications (N));
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, T);
+ end if;
end Analyze_Formal_Type_Declaration;
------------------------------------
@@ -2754,7 +2764,9 @@
end if;
end if;
- Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
end Analyze_Generic_Package_Declaration;
--------------------------------------------
@@ -2882,7 +2894,10 @@
Generate_Reference_To_Formals (Id);
List_Inherited_Pre_Post_Aspects (Id);
- Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
end Analyze_Generic_Subprogram_Declaration;
-----------------------------------
@@ -3556,9 +3571,10 @@
Set_Defining_Identifier (N, Act_Decl_Id);
end if;
- <<Leave>>
- Analyze_Aspect_Specifications
- (N, Act_Decl_Id, Aspect_Specifications (N));
+ <<Leave>>
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Act_Decl_Id);
+ end if;
exception
when Instantiation_Error =>
@@ -4336,9 +4352,10 @@
Generic_Renamings_HTable.Reset;
end if;
- <<Leave>>
- Analyze_Aspect_Specifications
- (N, Act_Decl_Id, Aspect_Specifications (N));
+ <<Leave>>
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Act_Decl_Id);
+ end if;
exception
when Instantiation_Error =>
===================================================================
@@ -23,7 +23,6 @@
-- --
------------------------------------------------------------------------------
-with Aspects; use Aspects;
with Atree; use Atree;
with Checks; use Checks;
with Debug; use Debug;
@@ -263,7 +262,10 @@
Generate_Reference_To_Formals (Designator);
Check_Eliminated (Designator);
- Analyze_Aspect_Specifications (N, Designator, Aspect_Specifications (N));
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Designator);
+ end if;
end Analyze_Abstract_Subprogram_Declaration;
---------------------------------
@@ -3067,7 +3069,10 @@
end if;
List_Inherited_Pre_Post_Aspects (Designator);
- Analyze_Aspect_Specifications (N, Designator, Aspect_Specifications (N));
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Designator);
+ end if;
end Analyze_Subprogram_Declaration;
--------------------------------------
===================================================================
@@ -23,7 +23,6 @@
-- --
------------------------------------------------------------------------------
-with Aspects; use Aspects;
with Atree; use Atree;
with Checks; use Checks;
with Einfo; use Einfo;
@@ -65,7 +64,10 @@
Set_Etype (Id, Standard_Exception_Type);
Set_Is_Statically_Allocated (Id);
Set_Is_Pure (Id, PF);
- Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
end Analyze_Exception_Declaration;
--------------------------------
===================================================================
@@ -78,16 +78,6 @@
-- inherited from a derived type that is no longer appropriate for the
-- new Esize value. In this case, we reset the Alignment to unknown.
- procedure Analyze_Non_Null_Aspect_Specifications
- (N : Node_Id;
- E : Entity_Id;
- L : List_Id);
- -- This procedure is called to analyze aspect specifications for node N.
- -- E is the corresponding entity declared by the declaration node N, and
- -- L is the list of aspect specifications for this node. This procedure
- -- does the real work, as opposed to Analyze_Aspect_Specifications which
- -- is inlined to fast-track the common case.
-
procedure Build_Predicate_Function (Typ : Entity_Id; N : Node_Id);
-- If Typ has predicates (indicated by Has_Predicates being set for Typ,
-- then either there are pragma Invariant entries on the rep chain for the
@@ -693,34 +683,13 @@
-- Analyze_Aspect_Specifications --
-----------------------------------
- procedure Analyze_Aspect_Specifications
- (N : Node_Id;
- E : Entity_Id;
- L : List_Id)
- is
- begin
- -- Return if no aspects
-
- if L = No_List then
- return;
- end if;
-
- Analyze_Non_Null_Aspect_Specifications (N, E, L);
- end Analyze_Aspect_Specifications;
-
- --------------------------------------------
- -- Analyze_Non_Null_Aspect_Specifications --
- --------------------------------------------
-
- procedure Analyze_Non_Null_Aspect_Specifications
- (N : Node_Id;
- E : Entity_Id;
- L : List_Id)
- is
+ procedure Analyze_Aspect_Specifications (N : Node_Id; E : Entity_Id) is
Aspect : Node_Id;
Aitem : Node_Id;
Ent : Node_Id;
+ L : constant List_Id := Aspect_Specifications (N);
+
Ins_Node : Node_Id := N;
-- Insert pragmas (except Pre/Post/Invariant/Predicate) after this node
@@ -744,10 +713,12 @@
-- Set True if delay is required
begin
+ pragma Assert (Present (L));
+
-- Loop through aspects
Aspect := First (L);
- while Present (Aspect) loop
+ Aspect_Loop : while Present (Aspect) loop
declare
Loc : constant Source_Ptr := Sloc (Aspect);
Id : constant Node_Id := Identifier (Aspect);
@@ -759,6 +730,72 @@
Eloc : Source_Ptr := Sloc (Expr);
-- Source location of expression, modified when we split PPC's
+ procedure Check_False_Aspect_For_Derived_Type;
+ -- This procedure checks for the case of a false aspect for a
+ -- derived type, which improperly tries to cancel an aspect
+ -- inherited from the parent;
+
+ -----------------------------------------
+ -- Check_False_Aspect_For_Derived_Type --
+ -----------------------------------------
+
+ procedure Check_False_Aspect_For_Derived_Type is
+ begin
+ -- We are only checking derived types
+
+ if not Is_Derived_Type (E) then
+ return;
+ end if;
+
+ case A_Id is
+ when Aspect_Atomic | Aspect_Shared =>
+ if not Is_Atomic (E) then
+ return;
+ end if;
+
+ when Aspect_Atomic_Components =>
+ if not Has_Atomic_Components (E) then
+ return;
+ end if;
+
+ when Aspect_Discard_Names =>
+ if not Discard_Names (E) then
+ return;
+ end if;
+
+ when Aspect_Pack =>
+ if not Is_Packed (E) then
+ return;
+ end if;
+
+ when Aspect_Unchecked_Union =>
+ if not Is_Unchecked_Union (E) then
+ return;
+ end if;
+
+ when Aspect_Volatile =>
+ if not Is_Volatile (E) then
+ return;
+ end if;
+
+ when Aspect_Volatile_Components =>
+ if not Has_Volatile_Components (E) then
+ return;
+ end if;
+
+ when others =>
+ return;
+ end case;
+
+ -- Fall through means we are canceling an inherited aspect
+
+ Error_Msg_Name_1 := Nam;
+ Error_Msg_NE
+ ("derived type& inherits aspect%, cannot cancel", Expr, E);
+ end Check_False_Aspect_For_Derived_Type;
+
+ -- Start of processing for Aspect_Loop
+
begin
-- Skip aspect if already analyzed (not clear if this is needed)
@@ -837,39 +874,37 @@
raise Program_Error;
-- Aspects taking an optional boolean argument. For all of
- -- 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.
+ -- these we just create a matching pragma and insert it, if
+ -- the expression is missing or set to True. If the expression
+ -- is False, we can ignore the aspect with the exception that
+ -- in the case of a derived type, we must check for an illegal
+ -- attempt to cancel an inherited aspect.
when Boolean_Aspects =>
Set_Is_Boolean_Aspect (Aspect);
- -- Build corresponding pragma node
+ if Present (Expr)
+ and then Is_False (Static_Boolean (Expr))
+ then
+ Check_False_Aspect_For_Derived_Type;
+ goto Continue;
+ end if;
+ -- If True, build corresponding pragma node
+
Aitem :=
Make_Pragma (Loc,
Pragma_Argument_Associations => New_List (Ent),
Pragma_Identifier =>
Make_Identifier (Sloc (Id), Chars (Id)));
- -- No delay required if no expression (nothing to delay!)
+ -- Never need to delay for boolean aspects
- if No (Expr) then
- Delay_Required := False;
+ Delay_Required := False;
- -- 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
- Delay_Required := True;
- Set_Is_Delayed_Aspect (Aspect);
- end if;
-
-- Library unit aspects. These are boolean aspects, but we
- -- always evaluate the expression right away if it is present
- -- and just ignore the aspect if the expression is False. We
- -- never delay expression evaluation in this case.
+ -- have to do special things with the insertion, since the
+ -- pragma belongs inside the declarations of a package.
when Library_Unit_Aspects =>
if Present (Expr)
@@ -1220,8 +1255,8 @@
<<Continue>>
Next (Aspect);
- end loop;
- end Analyze_Non_Null_Aspect_Specifications;
+ end loop Aspect_Loop;
+ end Analyze_Aspect_Specifications;
-----------------------
-- Analyze_At_Clause --
===================================================================
@@ -36,17 +36,10 @@
procedure Analyze_Record_Representation_Clause (N : Node_Id);
procedure Analyze_Code_Statement (N : Node_Id);
- procedure Analyze_Aspect_Specifications
- (N : Node_Id;
- E : Entity_Id;
- L : List_Id);
- -- This procedure is called to analyze aspect specifications for node N.
- -- E is the corresponding entity declared by the declaration node N, and
- -- L is the list of aspect specifications for this node. If L is No_List,
- -- the call is ignored. Note that we can't use a simpler interface of just
- -- passing the node N, since the analysis of the node may cause it to be
- -- rewritten to a node not permitting aspect specifications.
- pragma Inline (Analyze_Aspect_Specifications);
+ procedure Analyze_Aspect_Specifications (N : Node_Id; E : Entity_Id);
+ -- This procedure is called to analyze aspect specifications for node N. E
+ -- is the corresponding entity declared by the declaration node N. Callers
+ -- should check that Has_Aspects (N) is True before calling this routine.
procedure Adjust_Record_For_Reverse_Bit_Order (R : Entity_Id);
-- Called from Freeze where R is a record entity for which reverse bit
This patch fixes boolean aspects in two respects, first there is no delay in evaluation of the arguments. The following compiles clean and executes quietly in -gnata mode. 1. pragma Ada_2012; 2. procedure baspect1 is 3. type X is array (0 .. 31) of Boolean with 4. Pack => True; 5. True : constant Boolean := False; 6. begin 7. pragma Assert (X'Size = 32); 8. end; Second, it is no longer allowed to cancel inherited aspects on derived types, as shown by this example: 1. pragma Ada_2012; 2. package baspect2 is 3. type P is array (0 .. 31) of Boolean with 4. Pack => True; 5. type U is array (0 .. 31) of Boolean with 6. Pack => False; 7. type DP1 is new P with 8. Pack => True; -- OK 9. type DU1 is new U with 10. Pack => False; -- OK 11. type DP2 is new P with 12. Pack => False; -- ERROR | >>> derived type "DP2" inherits aspect "pack", cannot cancel 13. type DU2 is new U with 14. Pack => True; -- OK 15. end; In addition, the calling sequence of Analyze_Aspect_Specification is changed to improve performance efficiency (some slow down in compilation time was noticed from the previous implementation). Tested on x86_64-pc-linux-gnu, committed on trunk 2011-08-02 Robert Dewar <dewar@adacore.com> * sem_ch12.adb, sem_ch11.adb: New calling sequence for Analyze_Aspect_Specifications * sem_ch13.adb (Analyze_Aspect_Specifications): New handling for boolean aspects * sem_ch13.ads (Analyze_Aspect_Specifications): New calling sequence * sem_ch3.adb, sem_ch6.adb, sem_ch7.adb, sem_ch9.adb: New calling sequence for Analyze_Aspect_Specifications * sem_prag.adb (Analyze_Pragma): Remove use of Aspect_Cancel entirely * sinfo.ads, sinfo.adb (Aspect_Cancel): Remove, no longer used