This change moves the rest of the warning machinery for address clauses to
Validate_Address_Clauses, ensuring that all the variants are issued from it.
This affects only absolute address clauses in practice, i.e. address clauses
of the form for I'Address use To_Address (16#XXXX_XXXX#) and variants thereof.
This automatically brings a couple of improvements: warnings are more accurate
because they take into account the final alignment set by the back-end and they
catch more cases because the back-end sets the alignment of every single type
and object in the program. The warning also prints the alignment value now.
The following code gives an example of the warnings:
pragma Unsuppress (Alignment_Check);
1. with System.Storage_Elements; use System.Storage_Elements;
2.
3. package P is
4.
5. I : Integer;
6. for I'Address use To_Address (16#7FFF_0001#); -- warning
|
>>> warning: specified address for "I" is inconsistent with alignment
>>> warning: program execution may be erroneous (RM 13.3(27))
>>> warning: alignment of "I" is 4
7.
8. type Rec is record
9. I : Integer;
10. end record;
11.
12. R1 : Rec;
13. for R1'Address use To_Address (16#7FFF_0001#); -- warning
|
>>> warning: specified address for "R1" is inconsistent with alignment
>>> warning: program execution may be erroneous (RM 13.3(27))
>>> warning: alignment of "R1" is 4
14.
15. C : constant System.Address := To_Address (16#7FFF_0001#); -- warning
16.
17. R2 : Rec;
18. for R2'Address use C;
|
>>> warning: specified address for "R2" is inconsistent with alignment
>>> warning: program execution may be erroneous (RM 13.3(27))
>>> warning: alignment of "R2" is 4
19.
20. R3 : Rec;
21. for R3'Address use To_Address (16#7FFF_0004#); -- no warning
22.
23. end P;
23 lines: No errors, 9 warnings
Tested on x86_64-pc-linux-gnu, committed on trunk
2016-06-22 Eric Botcazou <ebotca...@adacore.com>
* sem_util.ads (Address_Value): Declare new function.
* sem_util.adb (Address_Value): New function extracted
unmodified from Apply_Address_Clause_Check, which returns the
underlying value of the expression of an address clause.
* checks.adb (Compile_Time_Bad_Alignment): Delete.
(Apply_Address_Clause_Check): Call Address_Value on
the expression. Do not issue the main warning here and
issue the secondary warning only when the value of the
expression is not known at compile time.
* sem_ch13.adb (Address_Clause_Check_Record): Add A component and
adjust the description.
(Analyze_Attribute_Definition_Clause): In the case
of an address, move up the code creating an entry in the table of
address clauses. Also create an entry for an absolute address.
(Validate_Address_Clauses): Issue the warning for absolute
addresses here too. Tweak condition associated with overlays
for consistency.
Index: checks.adb
===================================================================
--- checks.adb (revision 237687)
+++ checks.adb (revision 237688)
@@ -638,36 +638,12 @@
AC : constant Node_Id := Address_Clause (E);
Loc : constant Source_Ptr := Sloc (AC);
Typ : constant Entity_Id := Etype (E);
- Aexp : constant Node_Id := Expression (AC);
Expr : Node_Id;
-- Address expression (not necessarily the same as Aexp, for example
-- when Aexp is a reference to a constant, in which case Expr gets
-- reset to reference the value expression of the constant).
- procedure Compile_Time_Bad_Alignment;
- -- Post error warnings when alignment is known to be incompatible. Note
- -- that we do not go as far as inserting a raise of Program_Error since
- -- this is an erroneous case, and it may happen that we are lucky and an
- -- underaligned address turns out to be OK after all.
-
- --------------------------------
- -- Compile_Time_Bad_Alignment --
- --------------------------------
-
- procedure Compile_Time_Bad_Alignment is
- begin
- if Address_Clause_Overlay_Warnings then
- Error_Msg_FE
- ("?o?specified address for& may be inconsistent with alignment",
- Aexp, E);
- Error_Msg_FE
- ("\?o?program execution may be erroneous (RM 13.3(27))",
- Aexp, E);
- Set_Address_Warning_Posted (AC);
- end if;
- end Compile_Time_Bad_Alignment;
-
-- Start of processing for Apply_Address_Clause_Check
begin
@@ -690,44 +666,12 @@
-- Obtain expression from address clause
- Expr := Expression (AC);
+ Expr := Address_Value (Expression (AC));
- -- The following loop digs for the real expression to use in the check
+ -- See if we know that Expr has an acceptable value at compile time. If
+ -- it hasn't or we don't know, we defer issuing the warning until the
+ -- end of the compilation to take into account back end annotations.
- loop
- -- For constant, get constant expression
-
- if Is_Entity_Name (Expr)
- and then Ekind (Entity (Expr)) = E_Constant
- then
- Expr := Constant_Value (Entity (Expr));
-
- -- For unchecked conversion, get result to convert
-
- elsif Nkind (Expr) = N_Unchecked_Type_Conversion then
- Expr := Expression (Expr);
-
- -- For (common case) of To_Address call, get argument
-
- elsif Nkind (Expr) = N_Function_Call
- and then Is_Entity_Name (Name (Expr))
- and then Is_RTE (Entity (Name (Expr)), RE_To_Address)
- then
- Expr := First (Parameter_Associations (Expr));
-
- if Nkind (Expr) = N_Parameter_Association then
- Expr := Explicit_Actual_Parameter (Expr);
- end if;
-
- -- We finally have the real expression
-
- else
- exit;
- end if;
- end loop;
-
- -- See if we know that Expr has a bad alignment at compile time
-
if Compile_Time_Known_Value (Expr)
and then (Known_Alignment (E) or else Known_Alignment (Typ))
then
@@ -742,9 +686,7 @@
AL := Alignment (E);
end if;
- if Expr_Value (Expr) mod AL /= 0 then
- Compile_Time_Bad_Alignment;
- else
+ if Expr_Value (Expr) mod AL = 0 then
return;
end if;
end;
@@ -818,12 +760,11 @@
Warning_Msg := No_Error_Msg;
Analyze (First (Actions (N)), Suppress => All_Checks);
- -- If the address clause generated a warning message (for example,
+ -- If the above raise action generated a warning message (for example
-- from Warn_On_Non_Local_Exception mode with the active restriction
-- No_Exception_Propagation).
if Warning_Msg /= No_Error_Msg then
-
-- If the expression has a known at compile time value, then
-- once we know the alignment of the type, we can check if the
-- exception will be raised or not, and if not, we don't need
@@ -832,13 +773,13 @@
if Compile_Time_Known_Value (Expr) then
Alignment_Warnings.Append
((E => E, A => Expr_Value (Expr), W => Warning_Msg));
- end if;
+ else
+ -- Add explanation of the warning generated by the check
- -- Add explanation of the warning that is generated by the check
-
- Error_Msg_N
- ("\address value may be incompatible with alignment "
- & "of object?X?", AC);
+ Error_Msg_N
+ ("\address value may be incompatible with alignment "
+ & "of object?X?", AC);
+ end if;
end if;
return;
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 237687)
+++ sem_util.adb (revision 237688)
@@ -286,6 +286,49 @@
end if;
end Address_Integer_Convert_OK;
+ -------------------
+ -- Address_Value --
+ -------------------
+
+ function Address_Value (N : Node_Id) return Node_Id is
+ Expr : Node_Id := N;
+
+ begin
+ loop
+ -- For constant, get constant expression
+
+ if Is_Entity_Name (Expr)
+ and then Ekind (Entity (Expr)) = E_Constant
+ then
+ Expr := Constant_Value (Entity (Expr));
+
+ -- For unchecked conversion, get result to convert
+
+ elsif Nkind (Expr) = N_Unchecked_Type_Conversion then
+ Expr := Expression (Expr);
+
+ -- For (common case) of To_Address call, get argument
+
+ elsif Nkind (Expr) = N_Function_Call
+ and then Is_Entity_Name (Name (Expr))
+ and then Is_RTE (Entity (Name (Expr)), RE_To_Address)
+ then
+ Expr := First (Parameter_Associations (Expr));
+
+ if Nkind (Expr) = N_Parameter_Association then
+ Expr := Explicit_Actual_Parameter (Expr);
+ end if;
+
+ -- We finally have the real expression
+
+ else
+ exit;
+ end if;
+ end loop;
+
+ return Expr;
+ end Address_Value;
+
-----------------
-- Addressable --
-----------------
Index: sem_util.ads
===================================================================
--- sem_util.ads (revision 237687)
+++ sem_util.ads (revision 237688)
@@ -65,6 +65,9 @@
-- and one of the types is (a descendant of) System.Address (and this type
-- is private), and the other type is any integer type.
+ function Address_Value (N : Node_Id) return Node_Id;
+ -- Return the underlying value of the expression N of an address clause
+
function Addressable (V : Uint) return Boolean;
function Addressable (V : Int) return Boolean;
pragma Inline (Addressable);
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 237687)
+++ sem_ch13.adb (revision 237688)
@@ -273,9 +273,10 @@
-- for X'Address use Expr
- -- where Expr is of the form Y'Address or recursively is a reference to a
- -- constant of either of these forms, and X and Y are entities of objects,
- -- then if Y has a smaller alignment than X, that merits a warning about
+ -- where Expr has a value known at compile time or is of the form Y'Address
+ -- or recursively is a reference to a constant initialized with either of
+ -- these forms, and the value of Expr is not a multiple of X's alignment,
+ -- or if Y has a smaller alignment than X, then that merits a warning about
-- possible bad alignment. The following table collects address clauses of
-- this kind. We put these in a table so that they can be checked after the
-- back end has completed annotation of the alignments of objects, since we
@@ -286,13 +287,16 @@
-- The address clause
X : Entity_Id;
- -- The entity of the object overlaying Y
+ -- The entity of the object subject to the address clause
+ A : Uint;
+ -- The value of the address in the first case
+
Y : Entity_Id;
- -- The entity of the object being overlaid
+ -- The entity of the object being overlaid in the second case
Off : Boolean;
- -- Whether the address is offset within Y
+ -- Whether the address is offset within Y in the second case
end record;
package Address_Clause_Checks is new Table.Table (
@@ -4849,6 +4853,40 @@
Set_Overlays_Constant (U_Ent);
end if;
+ -- If the address clause is of the form:
+
+ -- for X'Address use Y'Address;
+
+ -- or
+
+ -- C : constant Address := Y'Address;
+ -- ...
+ -- for X'Address use C;
+
+ -- then we make an entry in the table to check the size
+ -- and alignment of the overlaying variable. But we defer
+ -- this check till after code generation to take full
+ -- advantage of the annotation done by the back end.
+
+ -- If the entity has a generic type, the check will be
+ -- performed in the instance if the actual type justifies
+ -- it, and we do not insert the clause in the table to
+ -- prevent spurious warnings.
+
+ -- Note: we used to test Comes_From_Source and only give
+ -- this warning for source entities, but we have removed
+ -- this test. It really seems bogus to generate overlays
+ -- that would trigger this warning in generated code.
+ -- Furthermore, by removing the test, we handle the
+ -- aspect case properly.
+
+ if Is_Object (O_Ent)
+ and then not Is_Generic_Type (Etype (U_Ent))
+ and then Address_Clause_Overlay_Warnings
+ then
+ Address_Clause_Checks.Append
+ ((N, U_Ent, No_Uint, O_Ent, Off));
+ end if;
else
-- If this is not an overlay, mark a variable as being
-- volatile to prevent unwanted optimizations. It's a
@@ -4861,6 +4899,21 @@
if Ekind (U_Ent) = E_Variable then
Set_Treat_As_Volatile (U_Ent);
end if;
+
+ -- Make an entry in the table for an absolute address as
+ -- above to check that the value is compatible with the
+ -- alignment of the object.
+
+ declare
+ Addr : constant Node_Id := Address_Value (Expr);
+ begin
+ if Compile_Time_Known_Value (Addr)
+ and then Address_Clause_Overlay_Warnings
+ then
+ Address_Clause_Checks.Append
+ ((N, U_Ent, Expr_Value (Addr), Empty, False));
+ end if;
+ end;
end if;
-- Overlaying controlled objects is erroneous. Emit warning
@@ -4950,41 +5003,6 @@
-- the variable, it is somewhere else.
Kill_Size_Check_Code (U_Ent);
-
- -- If the address clause is of the form:
-
- -- for Y'Address use X'Address
-
- -- or
-
- -- Const : constant Address := X'Address;
- -- ...
- -- for Y'Address use Const;
-
- -- then we make an entry in the table for checking the size
- -- and alignment of the overlaying variable. We defer this
- -- check till after code generation to take full advantage
- -- of the annotation done by the back end.
-
- -- If the entity has a generic type, the check will be
- -- performed in the instance if the actual type justifies
- -- it, and we do not insert the clause in the table to
- -- prevent spurious warnings.
-
- -- Note: we used to test Comes_From_Source and only give
- -- this warning for source entities, but we have removed
- -- this test. It really seems bogus to generate overlays
- -- that would trigger this warning in generated code.
- -- Furthermore, by removing the test, we handle the
- -- aspect case properly.
-
- if Present (O_Ent)
- and then Is_Object (O_Ent)
- and then not Is_Generic_Type (Etype (U_Ent))
- and then Address_Clause_Overlay_Warnings
- then
- Address_Clause_Checks.Append ((N, U_Ent, O_Ent, Off));
- end if;
end;
-- Not a valid entity for an address clause
@@ -13183,16 +13201,16 @@
if not Address_Warning_Posted (ACCR.N) then
Expr := Original_Node (Expression (ACCR.N));
- -- Get alignments
+ -- Get alignments, sizes and offset, if any
X_Alignment := Alignment (ACCR.X);
- Y_Alignment := Alignment (ACCR.Y);
+ X_Size := Esize (ACCR.X);
- -- Similarly obtain sizes and offset
+ if Present (ACCR.Y) then
+ Y_Alignment := Alignment (ACCR.Y);
+ Y_Size := Esize (ACCR.Y);
+ end if;
- X_Size := Esize (ACCR.X);
- Y_Size := Esize (ACCR.Y);
-
if ACCR.Off
and then Nkind (Expr) = N_Attribute_Reference
and then Attribute_Name (Expr) = Name_Address
@@ -13202,9 +13220,27 @@
X_Offs := Uint_0;
end if;
+ -- Check for known value not multiple of alignment
+
+ if No (ACCR.Y) then
+ if not Alignment_Checks_Suppressed (ACCR.X)
+ and then X_Alignment /= 0
+ and then ACCR.A mod X_Alignment /= 0
+ then
+ Error_Msg_NE
+ ("??specified address for& is inconsistent with "
+ & "alignment", ACCR.N, ACCR.X);
+ Error_Msg_N
+ ("\??program execution may be erroneous (RM 13.3(27))",
+ ACCR.N);
+
+ Error_Msg_Uint_1 := X_Alignment;
+ Error_Msg_NE ("\??alignment of & is ^", ACCR.N, ACCR.X);
+ end if;
+
-- Check for large object overlaying smaller one
- if Y_Size > Uint_0
+ elsif Y_Size > Uint_0
and then X_Size > Uint_0
and then X_Offs + X_Size > Y_Size
then
@@ -13232,7 +13268,7 @@
-- Note: we do not check the alignment if we gave a size
-- warning, since it would likely be redundant.
- elsif not Alignment_Checks_Suppressed (ACCR.Y)
+ elsif not Alignment_Checks_Suppressed (ACCR.X)
and then Y_Alignment /= Uint_0
and then
(Y_Alignment < X_Alignment
