-- whether a particular item appears in a mixed list of nodes and entities.
-- It is assumed that all nodes in the list have entities.
+ function Check_Kind (Nam : Name_Id) return Name_Id;
+ -- This function is used in connection with pragmas Assert, Check,
+ -- and assertion aspects and pragmas, to determine if Check pragmas
+ -- (or corresponding assertion aspects or pragmas) are currently active
+ -- as determined by the presence of -gnata on the command line (which
+ -- sets the default), and the appearance of pragmas Check_Policy and
+ -- Assertion_Policy as configuration pragmas either in a configuration
+ -- pragma file, or at the start of the current unit, or locally given
+ -- Check_Policy and Assertion_Policy pragmas that are currently active.
+ --
+ -- The value returned is one of the names Check, Ignore, Disable (On
+ -- returns Check, and Off returns Ignore).
+ --
+ -- Note: for assertion kinds Pre'Class, Post'Class, Invariant'Class,
+ -- and Type_Invariant'Class, the name passed is Name_uPre, Name_uPost,
+ -- Name_uInvariant, or Name_uType_Invariant, which corresponds to _Pre,
+ -- _Post, _Invariant, or _Type_Invariant, which are special names used
+ -- in identifiers to represent these attribute references.
+
procedure Collect_Subprogram_Inputs_Outputs
(Subp_Id : Entity_Id;
Subp_Inputs : in out Elist_Id;
-- For a pragma PPC in the extended main source unit, record enabled
-- status in SCO.
- if not Is_Ignored (N) and then not Split_PPC (N) then
+ if Is_Checked (N) and then not Split_PPC (N) then
Set_SCO_Pragma_Enabled (Loc);
end if;
Prag_Id := Get_Pragma_Id (Pname);
Pname := Original_Name (N);
- -- Check applicable policy. We skip this for a pragma that came from
- -- an aspect, since we already dealt with the Disable case, and we set
- -- the Is_Ignored flag at the time the aspect was analyzed.
+ -- Check applicable policy. We skip this if Is_Checked or Is_Ignored
+ -- is already set, indicating that we have already checked the policy
+ -- at the right point. This happens for example in the case of a pragma
+ -- that is derived from an Aspect.
+
+ if Is_Ignored (N) or else Is_Checked (N) then
+ null;
+
+ -- For a pragma that is a rewriting of another pragma, copy the
+ -- Is_Checked/Is_Ignored status from the rewritten pragma.
+
+ elsif Is_Rewrite_Substitution (N)
+ and then Nkind (Original_Node (N)) = N_Pragma
+ and then Original_Node (N) /= N
+ then
+ Set_Is_Ignored (N, Is_Ignored (Original_Node (N)));
+ Set_Is_Checked (N, Is_Checked (Original_Node (N)));
+
+ -- Otherwise query the applicable policy at this point
- if not From_Aspect_Specification (N) then
+ else
Check_Applicable_Policy (N);
-- If pragma is disabled, rewrite as NULL and skip analysis
Append_To (Newa, New_Copy_Tree (Arg2));
end if;
+ -- Rewrite as Check pragma
+
Rewrite (N,
Make_Pragma (Loc,
Chars => Name_Check,
Cname : Name_Id;
Str : Node_Id;
- Check_On : Boolean;
- -- Set True if category of assertions referenced by Name enabled
-
begin
GNAT_Pragma;
Check_At_Least_N_Arguments (2);
null;
end case;
- -- Set Check_On to indicate check status
+ -- Check applicable policy. We skip this if Checked/Ignored status
+ -- is already set (e.g. in the casse of a pragma from an aspect).
- -- If this comes from an aspect, we have already taken care of
- -- the policy active when the aspect was analyzed, and Is_Ignored
- -- is set appropriately already.
+ if Is_Checked (N) or else Is_Ignored (N) then
+ null;
- if From_Aspect_Specification (N) then
- Check_On := not Is_Ignored (N);
+ -- For a non-source pragma that is a rewriting of another pragma,
+ -- copy the Is_Checked/Ignored status from the rewritten pragma.
- -- Otherwise check the status right now
+ elsif Is_Rewrite_Substitution (N)
+ and then Nkind (Original_Node (N)) = N_Pragma
+ and then Original_Node (N) /= N
+ then
+ Set_Is_Ignored (N, Is_Ignored (Original_Node (N)));
+ Set_Is_Checked (N, Is_Checked (Original_Node (N)));
+
+ -- Otherwise query the applicable policy at this point
else
case Check_Kind (Cname) is
when Name_Ignore =>
- Check_On := False;
+ Set_Is_Ignored (N, True);
+ Set_Is_Checked (N, False);
when Name_Check =>
- Check_On := True;
+ Set_Is_Ignored (N, False);
+ Set_Is_Checked (N, True);
-- For disable, rewrite pragma as null statement and skip
-- rest of the analysis of the pragma.
when others =>
- if Check_On and then not Split_PPC (N) then
+ if Is_Checked (N) and then not Split_PPC (N) then
-- Mark pragma/aspect SCO as enabled
-- we do want to analyze (to get proper references).
-- The Preanalyze_And_Resolve routine does just what we want
- if not Check_On then
+ if Is_Ignored (N) then
Preanalyze_And_Resolve (Str, Standard_String);
-- Otherwise we need a proper analysis and expansion
-- null;
-- end if;
- -- The reason we do this rewriting during semantic analysis
- -- rather than as part of normal expansion is that we cannot
- -- analyze and expand the code for the boolean expression
- -- directly, or it may cause insertion of actions that would
- -- escape the attempt to suppress the check code.
+ -- The reason we do this rewriting during semantic analysis rather
+ -- than as part of normal expansion is that we cannot analyze and
+ -- expand the code for the boolean expression directly, or it may
+ -- cause insertion of actions that would escape the attempt to
+ -- suppress the check code.
-- Note that the Sloc for the if statement corresponds to the
-- argument condition, not the pragma itself. The reason for
-- False at compile time, and we do not want to delete this
-- warning when we delete the if statement.
- if Expander_Active and not Check_On then
+ if Expander_Active and Is_Ignored (N) then
Eloc := Sloc (Expr);
Rewrite (N,
Check_Optional_Identifier (Arg1, Name_Check);
Check_Precondition_Postcondition (In_Body);
- -- If in spec, nothing more to do. If in body, then we convert the
- -- pragma to an equivalent pragam Check. Note we do this whether
- -- or not precondition checks are enabled. That works fine since
- -- pragma Check will do this check, and will also analyze the
- -- condition itself in the proper context.
+ -- If in spec, nothing more to do. If in body, then we convert
+ -- the pragma to an equivalent pragma Check. That works fine since
+ -- pragma Check will analyze the condition in the proper context.
-- The form of the pragma Check is either:
-- pragmas are checked.
if In_Body then
+
+ -- Rewrite as Check pragma
+
Rewrite (N,
Make_Pragma (Loc,
Chars => Name_Check,
Pragma_Argument_Associations => New_List (
Make_Pragma_Argument_Association (Loc,
- Expression => Make_Identifier (Loc, Pname)),
+ Expression => Make_Identifier (Loc, Pname)),
Make_Pragma_Argument_Association (Sloc (Arg1),
- Expression => Relocate_Node (Get_Pragma_Arg (Arg1))))));
+ Expression =>
+ Relocate_Node (Get_Pragma_Arg (Arg1))))));
if Arg_Count = 2 then
Append_To (Pragma_Argument_Associations (N),
Make_Pragma_Argument_Association (Sloc (Arg2),
- Expression => Relocate_Node (Get_Pragma_Arg (Arg2))));
+ Expression =>
+ Relocate_Node (Get_Pragma_Arg (Arg2))));
end if;
Analyze (N);
Pnm : constant Name_Id := Chars (Get_Pragma_Arg (First (PPA)));
begin
- if Ename = Pnm or else Pnm = Name_Assertion then
+ if Ename = Pnm
+ or else Pnm = Name_Assertion
+ or else (Pnm = Name_Statement_Assertions
+ and then (Ename = Name_Assert or else
+ Ename = Name_Assert_And_Cut or else
+ Ename = Name_Assume or else
+ Ename = Name_Loop_Invariant))
+ then
Policy := Chars (Get_Pragma_Arg (Last (PPA)));
case Policy is
when Name_Off | Name_Ignore =>
Set_Is_Ignored (N, True);
+ Set_Is_Checked (N, False);
+
+ when Name_On | Name_Check =>
+ Set_Is_Checked (N, True);
+ Set_Is_Ignored (N, False);
when Name_Disable =>
Set_Is_Ignored (N, True);
+ Set_Is_Checked (N, False);
Set_Is_Disabled (N, True);
+ -- That should be exhaustive, the null here is a defence
+ -- against a malformed tree from previous errors.
+
when others =>
null;
end case;
-- compatibility with the RM for the cases of assertion, invariant,
-- precondition, predicate, and postcondition.
- if not Assertions_Enabled then
- Set_Is_Ignored (N);
+ if Assertions_Enabled then
+ Set_Is_Checked (N, True);
+ Set_Is_Ignored (N, False);
+ else
+ Set_Is_Checked (N, False);
+ Set_Is_Ignored (N, True);
end if;
end Check_Applicable_Policy;
-- 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_Checked (Flag11-Sem)
+ -- Present in N_Aspect_Specification and N_Pragma nodes. Set for an
+ -- assertion aspect or pragma, or check pragma for an assertion, that
+ -- is to be checked at run - time. If either Is_Checked or Is_Ignored
+ -- is set (they cannot both be set), then this means that the status of
+ -- the pragma has been checked at the appropriate point and should not
+ -- be further modified (in some cases these flags are copied when a
+ -- pragma is rewritten).
+
-- Is_Component_Left_Opnd (Flag13-Sem)
-- Is_Component_Right_Opnd (Flag14-Sem)
-- Present in concatenation nodes, to indicate that the corresponding
-- Is_Delayed_Aspect (Flag14-Sem)
-- Is_Disabled (Flag15-Sem)
-- Is_Ignored (Flag9-Sem)
+ -- Is_Checked (Flag11-Sem)
-- Import_Interface_Present (Flag16-Sem)
-- Split_PPC (Flag17) set if corresponding aspect had Split_PPC set
-- Next_Rep_Item (Node5-Sem)
-- Split_PPC (Flag17) Set if split pre/post attribute
-- Is_Boolean_Aspect (Flag16-Sem)
+ -- Is_Checked (Flag11-Sem)
-- Is_Delayed_Aspect (Flag14-Sem)
-- Is_Disabled (Flag15-Sem)
-- Is_Ignored (Flag9-Sem)
function Is_Boolean_Aspect
(N : Node_Id) return Boolean; -- Flag16
+ function Is_Checked
+ (N : Node_Id) return Boolean; -- Flag11
+
function Is_Component_Left_Opnd
(N : Node_Id) return Boolean; -- Flag13
procedure Set_Is_Boolean_Aspect
(N : Node_Id; Val : Boolean := True); -- Flag16
+ procedure Set_Is_Checked
+ (N : Node_Id; Val : Boolean := True); -- Flag11
+
procedure Set_Is_Component_Left_Opnd
(N : Node_Id; Val : Boolean := True); -- Flag13
pragma Inline (Is_Accessibility_Actual);
pragma Inline (Is_Asynchronous_Call_Block);
pragma Inline (Is_Boolean_Aspect);
+ pragma Inline (Is_Checked);
pragma Inline (Is_Component_Left_Opnd);
pragma Inline (Is_Component_Right_Opnd);
pragma Inline (Is_Controlling_Actual);
pragma Inline (Set_Is_Accessibility_Actual);
pragma Inline (Set_Is_Asynchronous_Call_Block);
pragma Inline (Set_Is_Boolean_Aspect);
+ pragma Inline (Set_Is_Checked);
pragma Inline (Set_Is_Component_Left_Opnd);
pragma Inline (Set_Is_Component_Right_Opnd);
pragma Inline (Set_Is_Controlling_Actual);
projects / thirdparty / gcc.git / commitdiff
