------------------------------
function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean is
- CR : Restrictions_Info renames Cumulative_Restrictions;
-
+ CR : Restrictions_Info renames Cumulative_Restrictions;
+ Result : Boolean;
begin
case R is
when All_Boolean_Restrictions =>
- -- The condition for listing a boolean restriction as an
- -- additional restriction that could be set is that it is
- -- not violated by any unit, and not already set.
+ -- Print it if not violated by any unit, and not already set...
+
+ Result := not CR.Violated (R) and then not CR.Set (R);
+
+ -- ...except that for No_Tasks_Unassigned_To_CPU, we don't want
+ -- to print it if it would violate the restriction post
+ -- compilation.
- return CR.Violated (R) = False and then CR.Set (R) = False;
+ if R = No_Tasks_Unassigned_To_CPU
+ and then ALIs.Table (ALIs.First).Main_CPU = No_Main_CPU
+ then
+ Result := False;
+ end if;
-- Parameter restriction
-- unknown, the restriction can definitely not be listed.
if CR.Violated (R) and then CR.Unknown (R) then
- return False;
+ Result := False;
-- We can list the restriction if it is not set
elsif not CR.Set (R) then
- return True;
+ Result := True;
-- We can list the restriction if is set to a greater value
-- than the maximum value known for the violation.
else
- return CR.Value (R) > CR.Count (R);
+ Result := CR.Value (R) > CR.Count (R);
end if;
-- No other values for R possible
when others =>
raise Program_Error;
end case;
+
+ return Result;
end Restriction_Could_Be_Set;
-- Start of processing for List_Applicable_Restrictions
-- mode where we want to be more flexible.
if not CodePeer_Mode then
+ -- AI12-0117-1, "Restriction No_Tasks_Unassigned_To_CPU":
+ -- If the restriction No_Tasks_Unassigned_To_CPU applies, then
+ -- check that the main subprogram has a CPU assigned.
+
+ if Cumulative_Restrictions.Set (No_Tasks_Unassigned_To_CPU)
+ and then ALIs.Table (ALIs.First).Main_CPU = No_Main_CPU
+ then
+ Error_Msg ("No_Tasks_Unassigned_To_CPU restriction requires CPU" &
+ " aspect to be specified for main procedure");
+ end if;
+
Check_Duplicated_Subunits;
Check_Versions;
Check_Consistency;
-- Set_Restriction --
---------------------
- -- Case of Boolean restriction
-
procedure Set_Restriction
(R : All_Boolean_Restrictions;
N : Node_Id)
end if;
end Set_Restriction;
- -- Case of parameter restriction
-
procedure Set_Restriction
(R : All_Parameter_Restrictions;
N : Node_Id;
Restriction_Profile_Name (R) := No_Profile;
end Set_Restriction;
+ procedure Set_Restriction
+ (R : All_Restrictions;
+ N : Node_Id;
+ Warn : Boolean;
+ V : Integer := Integer'First)
+ is
+ Set : Boolean := True;
+ begin
+ if Warn and then Restriction_Active (R) then
+ Set := False;
+ end if;
+
+ if Set then
+ if R in All_Boolean_Restrictions then
+ Set_Restriction (R, N);
+ else
+ Set_Restriction (R, N, V);
+ end if;
+
+ Restriction_Warnings (R) := Warn;
+ end if;
+ end Set_Restriction;
+
-----------------------------------
-- Set_Restriction_No_Dependence --
-----------------------------------
procedure Set_Restriction_No_Use_Of_Entity
(Entity : Node_Id;
- Warning : Boolean;
+ Warn : Boolean;
Profile : Profile_Name := No_Profile)
is
Nam : Node_Id;
-- Error has precedence over warning
- if not Warning then
+ if not Warn then
No_Use_Of_Entity.Table (J).Warn := False;
end if;
-- Entry is not currently in table
- No_Use_Of_Entity.Append ((Entity, Warning, Profile));
+ No_Use_Of_Entity.Append ((Entity, Warn, Profile));
-- Now we need to find the direct name and set Boolean2 flag
------------------------------------------------
procedure Set_Restriction_No_Specification_Of_Aspect
- (N : Node_Id;
- Warning : Boolean)
+ (N : Node_Id;
+ Warn : Boolean)
is
A_Id : constant Aspect_Id_Exclude_No_Aspect := Get_Aspect_Id (Chars (N));
begin
No_Specification_Of_Aspect_Set := True;
No_Specification_Of_Aspects (A_Id) := Sloc (N);
- No_Specification_Of_Aspect_Warning (A_Id) := Warning;
+ No_Specification_Of_Aspect_Warning (A_Id) := Warn;
end Set_Restriction_No_Specification_Of_Aspect;
procedure Set_Restriction_No_Specification_Of_Aspect (A_Id : Aspect_Id) is
-----------------------------------------
procedure Set_Restriction_No_Use_Of_Attribute
- (N : Node_Id;
- Warning : Boolean)
+ (N : Node_Id;
+ Warn : Boolean)
is
A_Id : constant Attribute_Id := Get_Attribute_Id (Chars (N));
begin
No_Use_Of_Attribute_Set := True;
No_Use_Of_Attribute (A_Id) := Sloc (N);
- No_Use_Of_Attribute_Warning (A_Id) := Warning;
+ No_Use_Of_Attribute_Warning (A_Id) := Warn;
end Set_Restriction_No_Use_Of_Attribute;
procedure Set_Restriction_No_Use_Of_Attribute (A_Id : Attribute_Id) is
--------------------------------------
procedure Set_Restriction_No_Use_Of_Pragma
- (N : Node_Id;
- Warning : Boolean)
+ (N : Node_Id;
+ Warn : Boolean)
is
A_Id : constant Pragma_Id := Get_Pragma_Id (Chars (N));
begin
No_Use_Of_Pragma_Set := True;
No_Use_Of_Pragma (A_Id) := Sloc (N);
- No_Use_Of_Pragma_Warning (A_Id) := Warning;
+ No_Use_Of_Pragma_Warning (A_Id) := Warn;
end Set_Restriction_No_Use_Of_Pragma;
procedure Set_Restriction_No_Use_Of_Pragma (A_Id : Pragma_Id) is
-- Similar to the above, except that this is used for the case of a
-- parameter restriction, and the corresponding value V is given.
+ procedure Set_Restriction
+ (R : All_Restrictions;
+ N : Node_Id;
+ Warn : Boolean;
+ V : Integer := Integer'First);
+ -- Same as above two, except also takes care of setting the
+ -- Restriction_Warnings flag. V is ignored for Boolean
+ -- restrictions.
+ --
+ -- If this is the first time we've seen this restriction, the warning flag
+ -- is set to Warn. If this is a second or subsequent time, Warn = False
+ -- wins; that is, errors always trump warnings. In that case, the warning
+ -- flag can be set to False, but never to True.
+
procedure Set_Restriction_No_Dependence
(Unit : Node_Id;
Warn : Boolean;
-- No_Dependence restriction comes from a Profile pragma.
procedure Set_Restriction_No_Specification_Of_Aspect
- (N : Node_Id;
- Warning : Boolean);
+ (N : Node_Id;
+ Warn : Boolean);
-- N is the node id for an identifier from a pragma Restrictions for the
-- No_Specification_Of_Aspect pragma. An error message will be issued if
-- the identifier is not a valid aspect name. Warning is set True for the
-- Version used by Get_Target_Parameters (via Tbuild)
procedure Set_Restriction_No_Use_Of_Attribute
- (N : Node_Id;
- Warning : Boolean);
+ (N : Node_Id;
+ Warn : Boolean);
-- N is the node id for the identifier in a pragma Restrictions for
-- No_Use_Of_Attribute. Caller has verified that this is a valid attribute
-- designator.
procedure Set_Restriction_No_Use_Of_Entity
(Entity : Node_Id;
- Warning : Boolean;
+ Warn : Boolean;
Profile : Profile_Name := No_Profile);
-- Sets given No_Use_Of_Entity restriction in table if not there already.
-- Warn is True if from Restriction_Warnings, or for Restrictions if the
-- the entity (to optimize table searches).
procedure Set_Restriction_No_Use_Of_Pragma
- (N : Node_Id;
- Warning : Boolean);
+ (N : Node_Id;
+ Warn : Boolean);
-- N is the node id for the identifier in a pragma Restrictions for
-- No_Use_Of_Pragma. Caller has verified that this is a valid pragma id.
Preanalyze_Spec_Expression (Expr, RTE (RE_CPU_Range));
Pop_Type (U_Ent);
- if not Is_OK_Static_Expression (Expr) then
+ -- AI12-0117-1, "Restriction No_Tasks_Unassigned_To_CPU":
+ -- If the expression is static, and its value is
+ -- System.Multiprocessors.Not_A_Specific_CPU (i.e. zero) then
+ -- that's a violation of No_Tasks_Unassigned_To_CPU. It might
+ -- seem better to refer to Not_A_Specific_CPU here, but that
+ -- involves a lot of horsing around with Rtsfind, and this
+ -- value is not going to change, so it's better to hardwire
+ -- Uint_0.
+ --
+ -- AI12-0055-1, "All properties of a usage profile are defined
+ -- by pragmas": If the expression is nonstatic, that's a
+ -- violation of No_Dynamic_CPU_Assignment.
+
+ if Is_OK_Static_Expression (Expr) then
+ if Expr_Value (Expr) = Uint_0 then
+ Check_Restriction (No_Tasks_Unassigned_To_CPU, Expr);
+ end if;
+ else
Check_Restriction (No_Dynamic_CPU_Assignment, Expr);
end if;
end if;
Set_Global_No_Tasking;
end if;
- -- If this is a warning, then set the warning unless we already
- -- have a real restriction active (we never want a warning to
- -- override a real restriction).
-
- if Warn then
- if not Restriction_Active (R_Id) then
- Set_Restriction (R_Id, N);
- Restriction_Warnings (R_Id) := True;
- end if;
+ Set_Restriction (R_Id, N, Warn);
- -- If real restriction case, then set it and make sure that the
- -- restriction warning flag is off, since a real restriction
- -- always overrides a warning.
+ if R_Id = No_Dynamic_CPU_Assignment
+ or else R_Id = No_Tasks_Unassigned_To_CPU
+ then
+ -- These imply No_Dependence =>
+ -- "System.Multiprocessors.Dispatching_Domains".
+ -- This is not strictly what the AI says, but it eliminates
+ -- the need for run-time checks, which are undesirable in
+ -- this context.
- else
- Set_Restriction (R_Id, N);
- Restriction_Warnings (R_Id) := False;
+ Set_Restriction_No_Dependence
+ (Sel_Comp
+ (Sel_Comp ("system", "multiprocessors", Loc),
+ "dispatching_domains"),
+ Warn);
+ end if;
+
+ if R_Id = No_Tasks_Unassigned_To_CPU then
+ -- Likewise, imply No_Dynamic_CPU_Assignment
+
+ Set_Restriction (No_Dynamic_CPU_Assignment, N, Warn);
end if;
-- Check for obsolescent restrictions in Ada 2005 mode
("pragma ignored, value too large??", Arg);
end if;
- -- Warning case. If the real restriction is active, then we
- -- ignore the request, since warning never overrides a real
- -- restriction. Otherwise we set the proper warning. Note that
- -- this circuit sets the warning again if it is already set,
- -- which is what we want, since the constant may have changed.
-
- if Warn then
- if not Restriction_Active (R_Id) then
- Set_Restriction
- (R_Id, N, Integer (UI_To_Int (Val)));
- Restriction_Warnings (R_Id) := True;
- end if;
-
- -- Real restriction case, set restriction and make sure warning
- -- flag is off since real restriction always overrides warning.
-
- else
- Set_Restriction (R_Id, N, Integer (UI_To_Int (Val)));
- Restriction_Warnings (R_Id) := False;
- end if;
+ Set_Restriction (R_Id, N, Warn, Integer (UI_To_Int (Val)));
end if;
Next (Arg);
Error_Msg_String (1 .. Name_Len) := Name_Buffer (1 .. Name_Len);
end Set_Error_Msg_To_Profile_Name;
- -- Local variables
-
- Nod : Node_Id;
- Pref : Node_Id;
- Pref_Id : Node_Id;
- Sel_Id : Node_Id;
-
Profile_Dispatching_Policy : Character;
-- Start of processing for Set_Ravenscar_Profile
-- No_Dependence => Ada.Calendar
-- No_Dependence => Ada.Task_Attributes
-- are already set by previous call to Set_Profile_Restrictions.
+ -- Really???
-- Set the following restrictions which were added to Ada 2005:
-- No_Dependence => Ada.Execution_Time.Group_Budget
-- No_Dependence => Ada.Execution_Time.Timers
if Ada_Version >= Ada_2005 then
- Pref_Id := Make_Identifier (Loc, Name_Find ("ada"));
- Sel_Id := Make_Identifier (Loc, Name_Find ("execution_time"));
-
- Pref :=
- Make_Selected_Component
- (Sloc => Loc,
- Prefix => Pref_Id,
- Selector_Name => Sel_Id);
-
- Sel_Id := Make_Identifier (Loc, Name_Find ("group_budgets"));
-
- Nod :=
- Make_Selected_Component
- (Sloc => Loc,
- Prefix => Pref,
- Selector_Name => Sel_Id);
-
- Set_Restriction_No_Dependence
- (Unit => Nod,
- Warn => Treat_Restrictions_As_Warnings,
- Profile => Ravenscar);
-
- Sel_Id := Make_Identifier (Loc, Name_Find ("timers"));
-
- Nod :=
- Make_Selected_Component
- (Sloc => Loc,
- Prefix => Pref,
- Selector_Name => Sel_Id);
-
- Set_Restriction_No_Dependence
- (Unit => Nod,
- Warn => Treat_Restrictions_As_Warnings,
- Profile => Ravenscar);
+ declare
+ Execution_Time : constant Node_Id :=
+ Sel_Comp ("ada", "execution_time", Loc);
+ Group_Budgets : constant Node_Id :=
+ Sel_Comp (Execution_Time, "group_budgets");
+ Timers : constant Node_Id :=
+ Sel_Comp (Execution_Time, "timers");
+ begin
+ Set_Restriction_No_Dependence
+ (Unit => Group_Budgets,
+ Warn => Treat_Restrictions_As_Warnings,
+ Profile => Ravenscar);
+ Set_Restriction_No_Dependence
+ (Unit => Timers,
+ Warn => Treat_Restrictions_As_Warnings,
+ Profile => Ravenscar);
+ end;
end if;
-- Set the following restriction which was added to Ada 2012 (see
-- No_Dependence => System.Multiprocessors.Dispatching_Domains
if Ada_Version >= Ada_2012 then
- Pref_Id := Make_Identifier (Loc, Name_Find ("system"));
- Sel_Id := Make_Identifier (Loc, Name_Find ("multiprocessors"));
-
- Pref :=
- Make_Selected_Component
- (Sloc => Loc,
- Prefix => Pref_Id,
- Selector_Name => Sel_Id);
-
- Sel_Id := Make_Identifier (Loc, Name_Find ("dispatching_domains"));
-
- Nod :=
- Make_Selected_Component
- (Sloc => Loc,
- Prefix => Pref,
- Selector_Name => Sel_Id);
-
Set_Restriction_No_Dependence
- (Unit => Nod,
+ (Sel_Comp
+ (Sel_Comp ("system", "multiprocessors", Loc),
+ "dispatching_domains"),
Warn => Treat_Restrictions_As_Warnings,
Profile => Ravenscar);
-- in Ada2012 (AI05-0174).
if Profile /= Jorvik then
- Pref_Id := Make_Identifier (Loc, Name_Find ("ada"));
- Sel_Id := Make_Identifier (Loc, Name_Find
- ("synchronous_barriers"));
-
- Nod :=
- Make_Selected_Component
- (Sloc => Loc,
- Prefix => Pref_Id,
- Selector_Name => Sel_Id);
-
Set_Restriction_No_Dependence
- (Unit => Nod,
+ (Sel_Comp ("ada", "synchronous_barriers", Loc),
Warn => Treat_Restrictions_As_Warnings,
Profile => Ravenscar);
end if;
Preanalyze_Spec_Expression (Arg, RTE (RE_CPU_Range));
- if not Is_OK_Static_Expression (Arg) then
+ -- See comment in Sem_Ch13 about the following restrictions
+
+ if Is_OK_Static_Expression (Arg) then
+ if Expr_Value (Arg) = Uint_0 then
+ Check_Restriction (No_Tasks_Unassigned_To_CPU, N);
+ end if;
+ else
Check_Restriction (No_Dynamic_CPU_Assignment, N);
end if;
return Result;
end OK_Convert_To;
+ --------------
+ -- Sel_Comp --
+ --------------
+
+ function Sel_Comp (Pre : Node_Id; Sel : String) return Node_Id is
+ begin
+ return Make_Selected_Component
+ (Sloc => Sloc (Pre),
+ Prefix => Pre,
+ Selector_Name => Make_Identifier (Sloc (Pre), Name_Find (Sel)));
+ end Sel_Comp;
+
+ function Sel_Comp (Pre, Sel : String; Loc : Source_Ptr) return Node_Id is
+ begin
+ return Sel_Comp (Make_Identifier (Loc, Name_Find (Pre)), Sel);
+ end Sel_Comp;
+
-------------
-- Set_NOD --
-------------
-- fixed-point small is called typ_SMALL where typ is the name of the
-- fixed-point type (as passed in Related_Id), and Suffix is "SMALL".
+ function Sel_Comp (Pre, Sel : String; Loc : Source_Ptr) return Node_Id;
+ function Sel_Comp (Pre : Node_Id; Sel : String) return Node_Id;
+ -- Create a selected component of the form Pre.Sel; that is, Pre is the
+ -- prefix, and Sel is the selector name.
+
function OK_Convert_To (Typ : Entity_Id; Expr : Node_Id) return Node_Id;
-- Like Convert_To, except that a conversion node is always generated, and
-- the Conversion_OK flag is set on this conversion node.
projects / gcc.git / commitdiff