[Ada] Clean up handling of assertions when disabled
Arnaud Charlet
charlet@adacore.com
Thu Apr 11 11:20:00 GMT 2013
This patch fixes a number of problems that arose from the handling
of assertions (more generally checks from pragma Checks). In
particular if a check was explicitly disabled with Check_Policy
then the argument was not analyzed leading to junk warnings.
The following should compile quietly with -gnatwa:
1. pragma Check_Policy (Assertion, Disable);
2. procedure Supcheck (X : Integer) is
3. Y : constant Integer := 32;
4. begin
5. pragma Assert (X > Y);
6. null;
7. end;
Previously there were warnings about X and Y not being referenced
In addition the following test:
1. procedure BadconcA (I : Integer; S1 : String; S2 : String) is
2. begin
3. pragma Assert (I > 0, S1 & S2);
4. null;
5. end;
generates the following expanded code:
procedure badconca (i : integer; s1 : string; s2 : string) is
subtype badconca__S2b is string (s2'first(1) .. s2'last(1));
subtype badconca__S1b is string (s1'first(1) .. s1'last(1));
begin
null;
return;
end badconca;
A previous attempt at fixing this by messing with Expand_Concatenate
has been reversed (it caused difficulties and also was not 100%
successful, since it left around a junk with of System__Concat_2.
Tested on x86_64-pc-linux-gnu, committed on trunk
2013-04-11 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb (Expand_Concatenate): Remove wrapping in
expression-with-actions node. No longer needed given fix to
sem_prag and caused loss of some useful warnings.
* sem.ads: Minor reformatting.
* sem_prag.adb (Check_Disabled): Removed, to be replaced by not
Check_Enabled. These two routines were curiously incompatible
causing confusion.
(Analyze_Pragma, case Check): Make sure we do
not expand the string argument if the check is disabled. Avoid
use of Check_Disabled, which resulted in missing analysis in
some cases.
* sem_prag.ads (Check_Disabled): Removed, to be replaced by not
Check_Enabled. These two routines were curiously incompatible
causing confusion.
-------------- next part --------------
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 197760)
+++ sem_prag.adb (working copy)
@@ -7833,6 +7833,7 @@
Expr : Node_Id;
Eloc : Source_Ptr;
Cname : Name_Id;
+ Str : Node_Id;
Check_On : Boolean;
-- Set True if category of assertions referenced by Name enabled
@@ -7846,22 +7847,16 @@
if Arg_Count = 3 then
Check_Optional_Identifier (Arg3, Name_Message);
- Analyze_And_Resolve (Get_Pragma_Arg (Arg3), Standard_String);
+ Str := Get_Pragma_Arg (Arg3);
end if;
Check_Arg_Is_Identifier (Arg1);
-
- -- Completely ignore if disabled
-
- if Check_Disabled (Chars (Get_Pragma_Arg (Arg1))) then
- Rewrite (N, Make_Null_Statement (Loc));
- Analyze (N);
- return;
- end if;
-
Cname := Chars (Get_Pragma_Arg (Arg1));
Check_On := Check_Enabled (Cname);
+ Expr := Get_Pragma_Arg (Arg2);
+ -- Deal with SCO generation
+
case Cname is
when Name_Predicate |
Name_Invariant =>
@@ -7882,28 +7877,52 @@
end if;
end case;
- -- If expansion is active and the check is not enabled then we
- -- rewrite the Check as:
+ -- Deal with analyzing the string argument.
+ if Arg_Count = 3 then
+
+ -- If checks are not on we don't want any expansion (since
+ -- such expansion would not get properly deleted) but
+ -- we do want to analyze (to get proper references).
+ -- The Preanalyze_And_Resolve routine does just what we want
+
+ if not Check_On then
+ Preanalyze_And_Resolve (Str, Standard_String);
+
+ -- Otherwise we need a proper analysis and expansion
+
+ else
+ Analyze_And_Resolve (Str, Standard_String);
+ end if;
+ 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.
+ -- 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.
+ -- 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.
- Expr := Get_Pragma_Arg (Arg2);
-
- if Expander_Active and then not Check_On then
+ if Expander_Active and not Check_On then
Eloc := Sloc (Expr);
Rewrite (N,
@@ -7915,9 +7934,12 @@
Then_Statements => New_List (
Make_Null_Statement (Eloc))));
+ In_Assertion_Expr := In_Assertion_Expr + 1;
Analyze (N);
+ In_Assertion_Expr := In_Assertion_Expr - 1;
- -- Check is active
+ -- Check is active or expansion not active. In these cases we can
+ -- just go ahead and analyze the boolean with no worries.
else
In_Assertion_Expr := In_Assertion_Expr + 1;
@@ -8314,7 +8336,7 @@
-- Completely ignore if disabled
- if Check_Disabled (Pname) then
+ if not Check_Enabled (Pname) then
Rewrite (N, Make_Null_Statement (Loc));
Analyze (N);
return;
@@ -12401,7 +12423,7 @@
-- Completely ignore if disabled
- if Check_Disabled (Pname) then
+ if not Check_Enabled (Pname) then
Rewrite (N, Make_Null_Statement (Loc));
Analyze (N);
return;
@@ -12474,7 +12496,7 @@
-- Completely ignore if disabled
- if Check_Disabled (Pname) then
+ if not Check_Enabled (Pname) then
Rewrite (N, Make_Null_Statement (Loc));
Analyze (N);
return;
@@ -16390,40 +16412,6 @@
when Pragma_Exit => null;
end Analyze_Pragma;
- --------------------
- -- Check_Disabled --
- --------------------
-
- function Check_Disabled (Nam : Name_Id) return Boolean is
- PP : Node_Id;
-
- begin
- -- Loop through entries in check policy list
-
- PP := Opt.Check_Policy_List;
- loop
- -- If there are no specific entries that matched, then nothing is
- -- disabled, so return False.
-
- if No (PP) then
- return False;
-
- -- Here we have an entry see if it matches
-
- else
- declare
- PPA : constant List_Id := Pragma_Argument_Associations (PP);
- begin
- if Nam = Chars (Get_Pragma_Arg (First (PPA))) then
- return Chars (Get_Pragma_Arg (Last (PPA))) = Name_Disable;
- else
- PP := Next_Pragma (PP);
- end if;
- end;
- end if;
- end loop;
- end Check_Disabled;
-
-------------------
-- Check_Enabled --
-------------------
@@ -16455,7 +16443,7 @@
case (Chars (Get_Pragma_Arg (Last (PPA)))) is
when Name_On | Name_Check =>
return True;
- when Name_Off | Name_Ignore =>
+ when Name_Off | Name_Disable | Name_Ignore =>
return False;
when others =>
raise Program_Error;
Index: sem_prag.ads
===================================================================
--- sem_prag.ads (revision 197743)
+++ sem_prag.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -54,13 +54,6 @@
-- of the expressions in the pragma as "spec expressions" (see section
-- in Sem "Handling of Default and Per-Object Expressions...").
- function Check_Disabled (Nam : Name_Id) return Boolean;
- -- This function is used in connection with pragmas Assertion, Check,
- -- Precondition, and Postcondition, to determine if Check pragmas (or
- -- corresponding Assert, Precondition, or Postcondition pragmas) are
- -- currently disabled (as set by a Check_Policy or Assertion_Policy pragma
- -- with the Disable argument).
-
function Check_Enabled (Nam : Name_Id) return Boolean;
-- This function is used in connection with pragmas Assertion, Check,
-- Precondition, and Postcondition, to determine if Check pragmas (or
Index: sem.ads
===================================================================
--- sem.ads (revision 197743)
+++ sem.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -177,7 +177,7 @@
-- repeatedly (for instance in the above aggregate "new Thing (Function_Call)"
-- needs to be called 100 times.)
--- The reason why this mechanism does not work is that, the expanded code for
+-- The reason why this mechanism does not work is that the expanded code for
-- the children is typically inserted above the parent and thus when the
-- father gets expanded no re-evaluation takes place. For instance in the case
-- of aggregates if "new Thing (Function_Call)" is expanded before of the
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb (revision 197760)
+++ exp_ch4.adb (working copy)
@@ -6796,28 +6796,8 @@
Append (Right_Opnd (Cnode), Opnds);
end loop Inner;
- -- Wrap the node to concatenate into an expression actions node to
- -- keep it nicely packaged. This is useful in the case of an assert
- -- pragma with a concatenation where we want to be able to delete
- -- the concatenation and all its expansion stuff.
+ Expand_Concatenate (Cnode, Opnds);
- declare
- Cnod : constant Node_Id := Relocate_Node (Cnode);
- Typ : constant Entity_Id := Base_Type (Etype (Cnode));
-
- begin
- -- Note: use Rewrite rather than Replace here, so that for example
- -- Why_Not_Static can find the original concatenation node OK!
-
- Rewrite (Cnode,
- Make_Expression_With_Actions (Sloc (Cnode),
- Actions => New_List (Make_Null_Statement (Sloc (Cnode))),
- Expression => Cnod));
-
- Expand_Concatenate (Cnod, Opnds);
- Analyze_And_Resolve (Cnode, Typ);
- end;
-
exit Outer when Cnode = N;
Cnode := Parent (Cnode);
end loop Outer;
@@ -11397,7 +11377,6 @@
function Is_Checked_Storage_Pool (P : Entity_Id) return Boolean is
T : Entity_Id;
-
begin
if No (P) then
return False;
More information about the Gcc-patches
mailing list