===================================================================
@@ -11270,30 +11270,36 @@
-- in the pragma, and is used to override the task stack size otherwise
-- associated with the task type.
- -- The _Priority field is always present. It will be filled at the freeze
- -- point, when the record init proc is built, to capture the expression of
- -- a Priority pragma, attribute definition clause or aspect specification
- -- (see Build_Record_Init_Proc in Exp_Ch3).
+ -- The _Priority field is present only if the task entity has a Priority or
+ -- Interrupt_Priority rep item (pragma, aspect specification or attribute
+ -- definition clause). It will be filled at the freeze point, when the
+ -- record init proc is built, to capture the expression of the rep item
+ -- (see Build_Record_Init_Proc in Exp_Ch3). Note that it cannot be filled
+ -- here since aspect evaluations are delayed till the freeze point.
-- The _Task_Info field is present only if a Task_Info pragma appears in
-- the task definition. The expression captures the argument that was
-- present in the pragma, and is used to provide the Task_Image parameter
-- to the call to Create_Task.
- -- The _CPU field is always present. It will be filled at the freeze point,
- -- when the record init proc is built, to capture the expression of a CPU
- -- pragma, attribute definition clause or aspect specification (see
- -- Build_Record_Init_Proc in Exp_Ch3).
+ -- The _CPU field is present only if the task entity has a CPU rep item
+ -- (pragma, aspect specification or attribute definition clause). It will
+ -- be filled at the freeze point, when the record init proc is built, to
+ -- capture the expression of the rep item (see Build_Record_Init_Proc in
+ -- Exp_Ch3). Note that it cannot be filled here since aspect evaluations
+ -- are delayed till the freeze point.
-- The _Relative_Deadline field is present only if a Relative_Deadline
-- pragma appears in the task definition. The expression captures the
-- argument that was present in the pragma, and is used to provide the
-- Relative_Deadline parameter to the call to Create_Task.
- -- The _Domain field is always present. It will be filled at the freeze
- -- point, when the record init proc is built, to capture the expression of
- -- a Dispatching_Domain pragma, attribute definition clause or aspect
- -- specification (see Build_Record_Init_Proc in Exp_Ch3).
+ -- The _Domain field is present only if the task entity has a
+ -- Dispatching_Domain rep item (pragma, aspect specification or attribute
+ -- definition clause). It will be filled at the freeze point, when the
+ -- record init proc is built, to capture the expression of the rep item
+ -- (see Build_Record_Init_Proc in Exp_Ch3). Note that it cannot be filled
+ -- here since aspect evaluations are delayed till the freeze point.
-- When a task is declared, an instance of the task value record is
-- created. The elaboration of this declaration creates the correct bounds
@@ -11566,17 +11572,20 @@
Collect_Entry_Families (Loc, Cdecls, Size_Decl, Tasktyp);
- -- Add the _Priority component with no expression
+ -- Add the _Priority component if a Interrupt_Priority or Priority rep
+ -- item is present.
- Append_To (Cdecls,
- Make_Component_Declaration (Loc,
- Defining_Identifier =>
- Make_Defining_Identifier (Loc, Name_uPriority),
- Component_Definition =>
- Make_Component_Definition (Loc,
- Aliased_Present => False,
- Subtype_Indication =>
- New_Reference_To (Standard_Integer, Loc))));
+ if Has_Rep_Item (TaskId, Name_Priority, Check_Parents => False) then
+ Append_To (Cdecls,
+ Make_Component_Declaration (Loc,
+ Defining_Identifier =>
+ Make_Defining_Identifier (Loc, Name_uPriority),
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Reference_To (Standard_Integer, Loc))));
+ end if;
-- Add the _Size component if a Storage_Size pragma is present
@@ -11623,18 +11632,20 @@
(TaskId, Name_Task_Info, Check_Parents => False)))))));
end if;
- -- Add the _CPU component with no expression
+ -- Add the _CPU component if a CPU rep item is present
- Append_To (Cdecls,
- Make_Component_Declaration (Loc,
- Defining_Identifier =>
- Make_Defining_Identifier (Loc, Name_uCPU),
+ if Has_Rep_Item (TaskId, Name_CPU, Check_Parents => False) then
+ Append_To (Cdecls,
+ Make_Component_Declaration (Loc,
+ Defining_Identifier =>
+ Make_Defining_Identifier (Loc, Name_uCPU),
- Component_Definition =>
- Make_Component_Definition (Loc,
- Aliased_Present => False,
- Subtype_Indication =>
- New_Reference_To (RTE (RE_CPU_Range), Loc))));
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Reference_To (RTE (RE_CPU_Range), Loc))));
+ end if;
-- Add the _Relative_Deadline component if a Relative_Deadline pragma is
-- present. If we are using a restricted run time this component will
@@ -11663,11 +11674,16 @@
Get_Relative_Deadline_Pragma (Taskdef))))))));
end if;
- -- Add the _Dispatching_Domain component with no expression. If we are
- -- using a restricted run time this component will not be added
- -- (dispatching domains are not allowed by the Ravenscar profile).
+ -- Add the _Dispatching_Domain component if a Dispatching_Domain rep
+ -- item is present. If we are using a restricted run time this component
+ -- will not be added (dispatching domains are not allowed by the
+ -- Ravenscar profile).
- if not Restricted_Profile then
+ if not Restricted_Profile
+ and then
+ Has_Rep_Item
+ (TaskId, Name_Dispatching_Domain, Check_Parents => False)
+ then
Append_To (Cdecls,
Make_Component_Declaration (Loc,
Defining_Identifier =>
@@ -13344,10 +13360,11 @@
-- Interrupt_Priority'Last, an implementation-defined value, see
-- (RM D.3(10)).
- if Has_Rep_Item (Ptyp, Name_Priority) then
+ if Has_Rep_Item (Ptyp, Name_Priority, Check_Parents => False) then
declare
Prio_Clause : constant Node_Id :=
- Get_Rep_Item (Ptyp, Name_Priority);
+ Get_Rep_Item
+ (Ptyp, Name_Priority, Check_Parents => False);
Prio : Node_Id;
Temp : Entity_Id;
@@ -13670,7 +13687,7 @@
-- Priority parameter. Set to Unspecified_Priority unless there is a
-- Priority rep item, in which case we take the value from the rep item.
- if Has_Rep_Item (Ttyp, Name_Priority) then
+ if Has_Rep_Item (Ttyp, Name_Priority, Check_Parents => False) then
Append_To (Args,
Make_Selected_Component (Loc,
Prefix => Make_Identifier (Loc, Name_uInit),
@@ -13741,7 +13758,7 @@
-- passed as an Integer because in the case of unspecified CPU the
-- value is not in the range of CPU_Range.
- if Has_Rep_Item (Ttyp, Name_CPU) then
+ if Has_Rep_Item (Ttyp, Name_CPU, Check_Parents => False) then
Append_To (Args,
Convert_To (Standard_Integer,
Make_Selected_Component (Loc,
@@ -13790,7 +13807,9 @@
-- Case where Dispatching_Domain rep item applies: use given value
- if Has_Rep_Item (Ttyp, Name_Dispatching_Domain) then
+ if Has_Rep_Item
+ (Ttyp, Name_Dispatching_Domain, Check_Parents => False)
+ then
Append_To (Args,
Make_Selected_Component (Loc,
Prefix =>
===================================================================
@@ -2525,14 +2525,14 @@
end if;
-- 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
+ -- aspect is required to be delayed to the freeze point, thus we
+ -- analyze the pragma or attribute definition clause in the tree at
-- this point. We also analyze the aspect specification node at the
-- freeze point when the aspect doesn't correspond to
-- pragma/attribute definition clause.
if Has_Delayed_Aspects (E) then
- Evaluate_Aspects_At_Freeze_Point (E);
+ Analyze_Aspects_At_Freeze_Point (E);
end if;
-- Here to freeze the entity
===================================================================
@@ -682,6 +682,227 @@
end if;
end Alignment_Check_For_Size_Change;
+ -------------------------------------
+ -- Analyze_Aspects_At_Freeze_Point --
+ -------------------------------------
+
+ procedure Analyze_Aspects_At_Freeze_Point (E : Entity_Id) is
+ ASN : Node_Id;
+ A_Id : Aspect_Id;
+ Ritem : Node_Id;
+
+ procedure Analyze_Aspect_Default_Value (ASN : Node_Id);
+ -- This routine analyzes an Aspect_Default_[Component_]Value denoted by
+ -- the aspect specification node ASN.
+
+ procedure Make_Pragma_From_Boolean_Aspect (ASN : Node_Id);
+ -- Given an aspect specification node ASN whose expression is an
+ -- optional Boolean, this routines creates the corresponding pragma
+ -- at the freezing point.
+
+ ----------------------------------
+ -- Analyze_Aspect_Default_Value --
+ ----------------------------------
+
+ procedure Analyze_Aspect_Default_Value (ASN : Node_Id) is
+ Ent : constant Entity_Id := Entity (ASN);
+ Expr : constant Node_Id := Expression (ASN);
+ Id : constant Node_Id := Identifier (ASN);
+
+ begin
+ Error_Msg_Name_1 := Chars (Id);
+
+ if not Is_Type (Ent) then
+ Error_Msg_N ("aspect% can only apply to a type", Id);
+ return;
+
+ elsif not Is_First_Subtype (Ent) then
+ Error_Msg_N ("aspect% cannot apply to subtype", Id);
+ return;
+
+ elsif A_Id = Aspect_Default_Value
+ and then not Is_Scalar_Type (Ent)
+ then
+ Error_Msg_N ("aspect% can only be applied to scalar type", Id);
+ return;
+
+ elsif A_Id = Aspect_Default_Component_Value then
+ if not Is_Array_Type (Ent) then
+ Error_Msg_N ("aspect% can only be applied to array type", Id);
+ return;
+
+ elsif not Is_Scalar_Type (Component_Type (Ent)) then
+ Error_Msg_N ("aspect% requires scalar components", Id);
+ return;
+ end if;
+ end if;
+
+ Set_Has_Default_Aspect (Base_Type (Ent));
+
+ if Is_Scalar_Type (Ent) then
+ Set_Default_Aspect_Value (Ent, Expr);
+ else
+ Set_Default_Aspect_Component_Value (Ent, Expr);
+ end if;
+ end Analyze_Aspect_Default_Value;
+
+ -------------------------------------
+ -- Make_Pragma_From_Boolean_Aspect --
+ -------------------------------------
+
+ procedure Make_Pragma_From_Boolean_Aspect (ASN : Node_Id) is
+ Ident : constant Node_Id := Identifier (ASN);
+ A_Name : constant Name_Id := Chars (Ident);
+ A_Id : constant Aspect_Id := Get_Aspect_Id (A_Name);
+ Ent : constant Entity_Id := Entity (ASN);
+ Expr : constant Node_Id := Expression (ASN);
+ Loc : constant Source_Ptr := Sloc (ASN);
+
+ Prag : Node_Id;
+
+ 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
+ Par : Node_Id;
+
+ begin
+ -- We are only checking derived types
+
+ if not Is_Derived_Type (E) then
+ return;
+ end if;
+
+ Par := Nearest_Ancestor (E);
+
+ case A_Id is
+ when Aspect_Atomic | Aspect_Shared =>
+ if not Is_Atomic (Par) then
+ return;
+ end if;
+
+ when Aspect_Atomic_Components =>
+ if not Has_Atomic_Components (Par) then
+ return;
+ end if;
+
+ when Aspect_Discard_Names =>
+ if not Discard_Names (Par) then
+ return;
+ end if;
+
+ when Aspect_Pack =>
+ if not Is_Packed (Par) then
+ return;
+ end if;
+
+ when Aspect_Unchecked_Union =>
+ if not Is_Unchecked_Union (Par) then
+ return;
+ end if;
+
+ when Aspect_Volatile =>
+ if not Is_Volatile (Par) then
+ return;
+ end if;
+
+ when Aspect_Volatile_Components =>
+ if not Has_Volatile_Components (Par) then
+ return;
+ end if;
+
+ when others =>
+ return;
+ end case;
+
+ -- Fall through means we are canceling an inherited aspect
+
+ Error_Msg_Name_1 := A_Name;
+ Error_Msg_NE ("derived type& inherits aspect%, cannot cancel",
+ Expr,
+ E);
+
+ end Check_False_Aspect_For_Derived_Type;
+
+ -- Start of processing for Make_Pragma_From_Boolean_Aspect
+
+ begin
+ if Is_False (Static_Boolean (Expr)) then
+ Check_False_Aspect_For_Derived_Type;
+
+ else
+ Prag :=
+ Make_Pragma (Loc,
+ Pragma_Argument_Associations => New_List (
+ New_Occurrence_Of (Ent, Sloc (Ident))),
+ Pragma_Identifier =>
+ Make_Identifier (Sloc (Ident), Chars (Ident)));
+
+ Set_From_Aspect_Specification (Prag, True);
+ Set_Corresponding_Aspect (Prag, ASN);
+ Set_Aspect_Rep_Item (ASN, Prag);
+ Set_Is_Delayed_Aspect (Prag);
+ Set_Parent (Prag, ASN);
+ end if;
+
+ end Make_Pragma_From_Boolean_Aspect;
+
+ -- Start of processing for Analyze_Aspects_At_Freeze_Point
+
+ begin
+ -- Must be declared in current scope. This is need for a generic
+ -- context.
+
+ if Scope (E) /= Current_Scope then
+ return;
+ end if;
+
+ -- Look for aspect specification entries for this entity
+
+ ASN := First_Rep_Item (E);
+
+ while Present (ASN) loop
+ if Nkind (ASN) = N_Aspect_Specification
+ and then Entity (ASN) = E
+ and then Is_Delayed_Aspect (ASN)
+ then
+ A_Id := Get_Aspect_Id (Chars (Identifier (ASN)));
+
+ case A_Id is
+ -- For aspects whose expression is an optional Boolean, make
+ -- the corresponding pragma at the freezing point.
+
+ when Boolean_Aspects |
+ Library_Unit_Aspects =>
+ Make_Pragma_From_Boolean_Aspect (ASN);
+
+ -- Special handling for aspects that don't correspond to
+ -- pragmas/attributes.
+
+ when Aspect_Default_Value |
+ Aspect_Default_Component_Value =>
+ Analyze_Aspect_Default_Value (ASN);
+
+ when others => null;
+ end case;
+
+ Ritem := Aspect_Rep_Item (ASN);
+
+ if Present (Ritem) then
+ Analyze (Ritem);
+ end if;
+ end if;
+
+ Next_Rep_Item (ASN);
+ end loop;
+ end Analyze_Aspects_At_Freeze_Point;
+
-----------------------------------
-- Analyze_Aspect_Specifications --
-----------------------------------
@@ -1199,7 +1420,6 @@
-- declaration. We do not have to worry about delay issues
-- since the pragma processing takes care of this.
- Set_Is_Delayed_Aspect (Aspect);
Delay_Required := False;
-- Case 3 : Aspects that don't correspond to pragma/attribute
@@ -7602,226 +7822,6 @@
end if;
end Check_Size;
- --------------------------------------
- -- Evaluate_Aspects_At_Freeze_Point --
- --------------------------------------
-
- procedure Evaluate_Aspects_At_Freeze_Point (E : Entity_Id) is
- ASN : Node_Id;
- A_Id : Aspect_Id;
- Ritem : Node_Id;
-
- procedure Analyze_Aspect_Default_Value (ASN : Node_Id);
- -- This routine analyzes an Aspect_Default_[Component_]Value denoted by
- -- the aspect specification node ASN.
-
- procedure Make_Pragma_From_Boolean_Aspect (ASN : Node_Id);
- -- Given an aspect specification node ASN whose expression is an
- -- optional Boolean, this routines creates the corresponding pragma
- -- at the freezing point.
-
- ----------------------------------
- -- Analyze_Aspect_Default_Value --
- ----------------------------------
-
- procedure Analyze_Aspect_Default_Value (ASN : Node_Id) is
- Ent : constant Entity_Id := Entity (ASN);
- Expr : constant Node_Id := Expression (ASN);
- Id : constant Node_Id := Identifier (ASN);
-
- begin
- Error_Msg_Name_1 := Chars (Id);
-
- if not Is_Type (Ent) then
- Error_Msg_N ("aspect% can only apply to a type", Id);
- return;
-
- elsif not Is_First_Subtype (Ent) then
- Error_Msg_N ("aspect% cannot apply to subtype", Id);
- return;
-
- elsif A_Id = Aspect_Default_Value
- and then not Is_Scalar_Type (Ent)
- then
- Error_Msg_N ("aspect% can only be applied to scalar type", Id);
- return;
-
- elsif A_Id = Aspect_Default_Component_Value then
- if not Is_Array_Type (Ent) then
- Error_Msg_N ("aspect% can only be applied to array type", Id);
- return;
-
- elsif not Is_Scalar_Type (Component_Type (Ent)) then
- Error_Msg_N ("aspect% requires scalar components", Id);
- return;
- end if;
- end if;
-
- Set_Has_Default_Aspect (Base_Type (Ent));
-
- if Is_Scalar_Type (Ent) then
- Set_Default_Aspect_Value (Ent, Expr);
- else
- Set_Default_Aspect_Component_Value (Ent, Expr);
- end if;
- end Analyze_Aspect_Default_Value;
-
- -------------------------------------
- -- Make_Pragma_From_Boolean_Aspect --
- -------------------------------------
-
- procedure Make_Pragma_From_Boolean_Aspect (ASN : Node_Id) is
- Ident : constant Node_Id := Identifier (ASN);
- A_Name : constant Name_Id := Chars (Ident);
- A_Id : constant Aspect_Id := Get_Aspect_Id (A_Name);
- Ent : constant Entity_Id := Entity (ASN);
- Expr : constant Node_Id := Expression (ASN);
- Loc : constant Source_Ptr := Sloc (ASN);
-
- Prag : Node_Id;
-
- 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
- Par : Node_Id;
-
- begin
- -- We are only checking derived types
-
- if not Is_Derived_Type (E) then
- return;
- end if;
-
- Par := Nearest_Ancestor (E);
-
- case A_Id is
- when Aspect_Atomic | Aspect_Shared =>
- if not Is_Atomic (Par) then
- return;
- end if;
-
- when Aspect_Atomic_Components =>
- if not Has_Atomic_Components (Par) then
- return;
- end if;
-
- when Aspect_Discard_Names =>
- if not Discard_Names (Par) then
- return;
- end if;
-
- when Aspect_Pack =>
- if not Is_Packed (Par) then
- return;
- end if;
-
- when Aspect_Unchecked_Union =>
- if not Is_Unchecked_Union (Par) then
- return;
- end if;
-
- when Aspect_Volatile =>
- if not Is_Volatile (Par) then
- return;
- end if;
-
- when Aspect_Volatile_Components =>
- if not Has_Volatile_Components (Par) then
- return;
- end if;
-
- when others =>
- return;
- end case;
-
- -- Fall through means we are canceling an inherited aspect
-
- Error_Msg_Name_1 := A_Name;
- Error_Msg_NE ("derived type& inherits aspect%, cannot cancel",
- Expr,
- E);
-
- end Check_False_Aspect_For_Derived_Type;
-
- -- Start of processing for Make_Pragma_From_Boolean_Aspect
-
- begin
- if Is_False (Static_Boolean (Expr)) then
- Check_False_Aspect_For_Derived_Type;
-
- else
- Prag :=
- Make_Pragma (Loc,
- Pragma_Argument_Associations => New_List (
- New_Occurrence_Of (Ent, Sloc (Ident))),
- Pragma_Identifier =>
- Make_Identifier (Sloc (Ident), Chars (Ident)));
-
- Set_From_Aspect_Specification (Prag, True);
- Set_Corresponding_Aspect (Prag, ASN);
- Set_Aspect_Rep_Item (ASN, Prag);
- Set_Is_Delayed_Aspect (Prag);
- Set_Parent (Prag, ASN);
- end if;
-
- end Make_Pragma_From_Boolean_Aspect;
-
- -- Start of processing for Evaluate_Aspects_At_Freeze_Point
-
- begin
- -- Must be declared in current scope
-
- if Scope (E) /= Current_Scope then
- return;
- end if;
-
- -- Look for aspect specification entries for this entity
-
- ASN := First_Rep_Item (E);
-
- while Present (ASN) loop
- if Nkind (ASN) = N_Aspect_Specification
- and then Entity (ASN) = E
- and then Is_Delayed_Aspect (ASN)
- then
- A_Id := Get_Aspect_Id (Chars (Identifier (ASN)));
-
- case A_Id is
- -- For aspects whose expression is an optional Boolean, make
- -- the corresponding pragma at the freezing point.
-
- when Boolean_Aspects |
- Library_Unit_Aspects =>
- Make_Pragma_From_Boolean_Aspect (ASN);
-
- -- Special handling for aspects that don't correspond to
- -- pragmas/attributes.
-
- when Aspect_Default_Value |
- Aspect_Default_Component_Value =>
- Analyze_Aspect_Default_Value (ASN);
-
- when others => null;
- end case;
-
- Ritem := Aspect_Rep_Item (ASN);
-
- if Present (Ritem) then
- Analyze (Ritem);
- end if;
- end if;
-
- Next_Rep_Item (ASN);
- end loop;
- end Evaluate_Aspects_At_Freeze_Point;
-
-------------------------
-- Get_Alignment_Value --
-------------------------
===================================================================
@@ -299,6 +299,9 @@
-- Quite an awkward procedure, but this is an awkard requirement!
+ procedure Analyze_Aspects_At_Freeze_Point (E : Entity_Id);
+ -- Analyze all the delayed aspects for entity E at freezing point
+
procedure Check_Aspect_At_Freeze_Point (ASN : Node_Id);
-- Performs the processing described above at the freeze point, ASN is the
-- N_Aspect_Specification node for the aspect.
@@ -307,7 +310,4 @@
-- Performs the processing described above at the freeze all point, and
-- issues appropriate error messages if the visibility has indeed changed.
-- Again, ASN is the N_Aspect_Specification node for the aspect.
-
- procedure Evaluate_Aspects_At_Freeze_Point (E : Entity_Id);
- -- Evaluates all the delayed aspects for entity E at freezing point
end Sem_Ch13;
===================================================================
@@ -2668,7 +2668,9 @@
Ritem :=
Get_Rep_Item
- (Corresponding_Concurrent_Type (Scope (Id)), Nam);
+ (Corresponding_Concurrent_Type (Scope (Id)),
+ Nam,
+ Check_Parents => False);
if Present (Ritem) then