if Scope_Is_Transient and then N = Node_To_Be_Wrapped then
case Nkind (N) is
- when N_Procedure_Call_Statement
+ when N_Pragma
+ | N_Procedure_Call_Statement
| N_Statement_Other_Than_Procedure_Call
=>
Wrap_Transient_Statement (N);
end loop;
end if;
- -- Don't count pragmas
+ -- Don't count pragmas, unless they are assertions that expect to
+ -- fail.
- while Nkind (Last_Stm) = N_Pragma
+ while (Nkind (Last_Stm) = N_Pragma and then not Assert_False)
-- Don't count call to SS_Release (can happen after
-- Raise_Exception).
-- restore the Ghost mode.
when Pragma_Check => Check : declare
+ procedure Check_Assertion_Failure (Arg_Check : Node_Id);
+ -- Check whether an Assert or a Check pragma evaluates to False,
+ -- except when the condition was explicitly set to False, and emit
+ -- a warning.
procedure Handle_Dynamic_Predicate_Check;
-- Enable or ignore the pragma depending on whether dynamic
end if;
end Handle_Dynamic_Predicate_Check;
+ -----------------------------
+ -- Check_Assertion_Failure --
+ -----------------------------
+
+ procedure Check_Assertion_Failure (Arg_Check : Node_Id) is
+ Orig_Check : Node_Id;
+ begin
+ if not Warn_On_Assertion_Failure
+ or else not Is_Entity_Name (Arg_Check)
+ or else not (Entity (Arg_Check) = Standard_False)
+ then
+ return;
+ end if;
+
+ Orig_Check := Original_Node (Arg_Check);
+
+ -- Don't warn if original condition is explicit False, since
+ -- obviously the failure is expected in this case.
+
+ if Is_Entity_Name (Orig_Check)
+ and then Entity (Orig_Check) = Standard_False
+ then
+ return;
+ end if;
+
+ case Pname is
+ when Name_Assert =>
+ -- Note: Use Error_Msg_F here rather than Error_Msg_N.
+ -- The source location of the expression is not usually
+ -- the best choice here. For example, it gets located on
+ -- the last AND keyword in a chain of boolean expressiond
+ -- AND'ed together. It is best to put the message on the
+ -- first character of the assertion, which is the effect
+ -- of the First_Node call here.
+
+ Error_Msg_F
+ ("?.a?assertion would fail at run time!", Arg_Check);
+
+ when Name_Check =>
+ Error_Msg_F
+ ("?.a?check would fail at run time!", Arg_Check);
+ when others =>
+ null;
+ end case;
+ end Check_Assertion_Failure;
+
-- Local variables
Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config;
Arg_Message : Node_Id renames Args (3);
Cname : Name_Id;
- Eloc : Source_Ptr;
-- Start of processing for Pragma_Check
Preanalyze_And_Resolve (Arg_Message, Standard_String);
end if;
- -- Now you might think we could just do the same with the Boolean
- -- expression if checks are off (and expansion is on) and then
- -- rewrite the check as a null statement. This would work but we
- -- would lose the useful warnings about an assertion being bound
- -- to fail even if assertions are turned off.
-
- -- So instead we wrap the boolean expression in an if statement
- -- that looks like:
-
- -- if False and then condition then
- -- 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.
-
- -- Note that the Sloc for the if statement corresponds to the
- -- argument condition, not the pragma itself. The reason for
- -- this is that we may generate a warning if the condition is
- -- False at compile time, and we do not want to delete this
- -- warning when we delete the if statement.
-
if Expander_Active and Is_Ignored_In_Codegen (N) then
- -- Mark pragma as ignored ghost to reuse the same removal
- -- process.
+ -- Even though technically ignored assertions are not ghost
+ -- code they should behave the same way. Meaning that they
+ -- should be analyzed but they should not affect the generated
+ -- code. Use the ignored ghost mechanism here to ensure that
+ -- the original pragma and any expanded code is also removed.
+ -- Ideally these two cases should be separated in the
+ -- implementation ???
Mark_Ghost_Pragma (N, Opt.Ignore);
- Eloc := Sloc (Arg_Check);
+ In_Assertion_Expr := In_Assertion_Expr + 1;
+ Analyze_And_Resolve (Arg_Check, Any_Boolean);
+ In_Assertion_Expr := In_Assertion_Expr - 1;
- Rewrite (N,
- Make_If_Statement (Eloc,
- Condition =>
- Make_And_Then (Eloc,
- Left_Opnd => Make_Identifier (Eloc, Name_False),
- Right_Opnd => Arg_Check),
- Then_Statements => New_List (
- Make_Null_Statement (Eloc))));
+ -- Suppress any warnings on the condition we might get
- -- Now go ahead and analyze the if statement
+ Kill_Dead_Code (Arg_Check);
- In_Assertion_Expr := In_Assertion_Expr + 1;
- Analyze (N);
- In_Assertion_Expr := In_Assertion_Expr - 1;
+ -- Warn if the condition is known to fail statically
+
+ Check_Assertion_Failure (Arg_Check);
-- Check is active or expansion not active. In these cases we can
-- just go ahead and analyze the boolean with no worries.
B_Typ : constant Entity_Id := Base_Type (Typ);
L : constant Node_Id := Left_Opnd (N);
R : constant Node_Id := Right_Opnd (N);
-
begin
-- Ensure all actions associated with the left operand (e.g.
-- finalization of transient objects) are fully evaluated locally within
Resolve (L, B_Typ);
Resolve (R, B_Typ);
- -- Check for issuing warning for always False assert/check, this happens
- -- when assertions are turned off, in which case the pragma Assert/Check
- -- was transformed into:
-
- -- if False and then <condition> then ...
-
- -- and we detect this pattern
-
- if Warn_On_Assertion_Failure
- and then Is_Entity_Name (R)
- and then Entity (R) = Standard_False
- and then Nkind (Parent (N)) = N_If_Statement
- and then Nkind (N) = N_And_Then
- and then Is_Entity_Name (L)
- and then Entity (L) = Standard_False
- then
- declare
- Orig : constant Node_Id := Original_Node (Parent (N));
-
- begin
- -- Special handling of Asssert pragma
-
- if Nkind (Orig) = N_Pragma
- and then Pragma_Name (Orig) = Name_Assert
- then
- declare
- Expr : constant Node_Id :=
- Original_Node
- (Expression
- (First (Pragma_Argument_Associations (Orig))));
-
- begin
- -- Don't warn if original condition is explicit False,
- -- since obviously the failure is expected in this case.
-
- if Is_Entity_Name (Expr)
- and then Entity (Expr) = Standard_False
- then
- null;
-
- -- Issue warning. We do not want the deletion of the
- -- IF/AND-THEN to take this message with it. We achieve this
- -- by making sure that the expanded code points to the Sloc
- -- of the expression, not the original pragma.
-
- else
- -- Note: Use Error_Msg_F here rather than Error_Msg_N.
- -- The source location of the expression is not usually
- -- the best choice here. For example, it gets located on
- -- the last AND keyword in a chain of boolean expressiond
- -- AND'ed together. It is best to put the message on the
- -- first character of the assertion, which is the effect
- -- of the First_Node call here.
-
- Error_Msg_F
- ("?.a?assertion would fail at run time!",
- Expression
- (First (Pragma_Argument_Associations (Orig))));
- end if;
- end;
-
- -- Similar processing for Check pragma
-
- elsif Nkind (Orig) = N_Pragma
- and then Pragma_Name (Orig) = Name_Check
- then
- -- Don't want to warn if original condition is explicit False
-
- declare
- Expr : constant Node_Id :=
- Original_Node
- (Expression
- (Next (First (Pragma_Argument_Associations (Orig)))));
- begin
- if Is_Entity_Name (Expr)
- and then Entity (Expr) = Standard_False
- then
- null;
-
- -- Post warning
-
- else
- -- Again use Error_Msg_F rather than Error_Msg_N, see
- -- comment above for an explanation of why we do this.
-
- Error_Msg_F
- ("?.a?check would fail at run time!",
- Expression
- (Last (Pragma_Argument_Associations (Orig))));
- end if;
- end;
- end if;
- end;
- end if;
-
-- Continue with processing of short circuit
Check_Unset_Reference (L);
Item_Nam :=
Chars (Original_Node (Pragma_Identifier (Original_Node (Item))));
- if Item_Nam = Name_Check then
+ if Item_Nam = Name_Check and then not Comes_From_Source (Item) then
-- Pragma "Check" preserves the original pragma name as its first
-- argument.
Item_Nam :=
with Restrict; use Restrict;
with Rident; use Rident;
with Sinfo.Utils; use Sinfo.Utils;
-with Sem_Util; use Sem_Util;
with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
Has_Created_Identifier : Boolean := False;
End_Label : Node_Id := Empty) return Node_Id
is
- P : Node_Id;
- Check_Restrictions : Boolean := True;
- begin
- -- Do not check restrictions if the implicit loop statement is part
- -- of a dead branch: False and then ...
- -- This will occur in particular as part of the expansion of pragma
- -- Assert when assertions are disabled.
-
- P := Parent (Node);
- while Present (P) loop
- if Nkind (P) = N_And_Then then
- if Nkind (Left_Opnd (P)) = N_Identifier
- and then Entity (Left_Opnd (P)) = Standard_False
- then
- Check_Restrictions := False;
- exit;
- end if;
-
- -- Prevent the search from going too far
-
- elsif Is_Body_Or_Package_Declaration (P) then
- exit;
- end if;
-
- P := Parent (P);
- end loop;
+ -- Avoid constraint checks in ignored ghost regions that are going to be
+ -- removed later.
+ Check_Restrictions : constant Boolean :=
+ Ghost_Config.Ghost_Mode /= Ignore;
+ begin
if Check_Restrictions then
Check_Restriction (No_Implicit_Loops, Node);
projects / thirdparty / gcc.git / commitdiff
