Skip to content

R
riscv-gcc-1
Commit e9c12b91 by Arnaud Charlet
Options

[multiple changes] 

2015-11-25  Bob Duff  <duff@adacore.com>

	* sem_elab.adb (Check_Internal_Call_Continue): Code clean ups.

2015-11-25  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_util.ads (Has_Compatible_Alignment): Add Layout_Done
	parameter.
	* sem_util.adb (Has_Compatible_Alignment): Likewise.
	(Has_Compatible_Alignment_Internal): Likewise.	Do not set the
	result to Unknown for packed types if Layout_Done is true.
	* checks.adb (Apply_Address_Clause_Check): Adjust call and
	pass False to Has_Compatible_Alignment.
	* sem_ch13.adb (Validate_Address_Clauses): Likewise but pass True.

From-SVN: r230877
parent 3429710e
Showing with 74 additions and 51 deletions
gcc/ada/ChangeLog
2015-11-25 Bob Duff <duff@adacore.com>
* sem_elab.adb (Check_Internal_Call_Continue): Code clean ups.
2015-11-25 Eric Botcazou <ebotcazou@adacore.com>
* sem_util.ads (Has_Compatible_Alignment): Add Layout_Done
parameter.
* sem_util.adb (Has_Compatible_Alignment): Likewise.
(Has_Compatible_Alignment_Internal): Likewise. Do not set the
result to Unknown for packed types if Layout_Done is true.
* checks.adb (Apply_Address_Clause_Check): Adjust call and
pass False to Has_Compatible_Alignment.
* sem_ch13.adb (Validate_Address_Clauses): Likewise but pass True.
2015-11-25 Vincent Celier <celier@adacore.com>
* gnatcmd.adb: When <target>-gnat is called with switch -P
......
gcc/ada/checks.adb
......@@ -749,14 +749,15 @@ package body Checks is
end if;
end;
-- If the expression has the form X'Address, then we can find out if
-- the object X has an alignment that is compatible with the object E.
-- 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.
-- If the expression has the form X'Address, then we can find out if the
-- object X has an alignment that is compatible with the object E. 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.
elsif Nkind (Expr) = N_Attribute_Reference
and then Attribute_Name (Expr) = Name_Address
and then Has_Compatible_Alignment (E, Prefix (Expr)) = Known_Compatible
and then
Has_Compatible_Alignment (E, Prefix (Expr), False) = Known_Compatible
then
return;
end if;
......
gcc/ada/sem_ch13.adb
......@@ -13097,16 +13097,15 @@ package body Sem_Ch13 is
and then X_Size > Uint_0
and then X_Size > Y_Size
then
Error_Msg_NE
("??& overlays smaller object", ACCR.N, ACCR.X);
Error_Msg_NE ("??& overlays smaller object", ACCR.N, ACCR.X);
Error_Msg_N
("\??program execution may be erroneous", ACCR.N);
Error_Msg_Uint_1 := X_Size;
Error_Msg_NE
("\??size of & is ^", ACCR.N, ACCR.X);
Error_Msg_NE ("\??size of & is ^", ACCR.N, ACCR.X);
Error_Msg_Uint_1 := Y_Size;
Error_Msg_NE
("\??size of & is ^", ACCR.N, ACCR.Y);
Error_Msg_NE ("\??size of & is ^", ACCR.N, ACCR.Y);
-- Check for inadequate alignment, both of the base object
-- and of the offset, if any. We only do this check if the
......@@ -13119,32 +13118,32 @@ package body Sem_Ch13 is
elsif not Alignment_Checks_Suppressed (ACCR.Y)
and then Y_Alignment /= Uint_0
and then (Y_Alignment < X_Alignment
or else (ACCR.Off
and then
Nkind (Expr) = N_Attribute_Reference
and then
Attribute_Name (Expr) = Name_Address
and then
Has_Compatible_Alignment
(ACCR.X, Prefix (Expr))
/= Known_Compatible))
and then
(Y_Alignment < X_Alignment
or else
(ACCR.Off
and then Nkind (Expr) = N_Attribute_Reference
and then Attribute_Name (Expr) = Name_Address
and then Has_Compatible_Alignment
(ACCR.X, Prefix (Expr), True) /=
Known_Compatible))
then
Error_Msg_NE
("??specified address for& may be inconsistent "
& "with alignment", ACCR.N, ACCR.X);
("??specified address for& may be 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);
Error_Msg_NE ("\??alignment of & is ^", ACCR.N, ACCR.X);
Error_Msg_Uint_1 := Y_Alignment;
Error_Msg_NE
("\??alignment of & is ^", ACCR.N, ACCR.Y);
Error_Msg_NE ("\??alignment of & is ^", ACCR.N, ACCR.Y);
if Y_Alignment >= X_Alignment then
Error_Msg_N
("\??but offset is not multiple of alignment", ACCR.N);
("\??but offset is not multiple of alignment", ACCR.N);
end if;
end if;
end if;
......
gcc/ada/sem_util.adb
......@@ -8368,13 +8368,15 @@ package body Sem_Util is
------------------------------
function Has_Compatible_Alignment
(Obj : Entity_Id;
Expr : Node_Id) return Alignment_Result
(Obj : Entity_Id;
Expr : Node_Id;
Layout_Done : Boolean) return Alignment_Result
is
function Has_Compatible_Alignment_Internal
(Obj : Entity_Id;
Expr : Node_Id;
Default : Alignment_Result) return Alignment_Result;
(Obj : Entity_Id;
Expr : Node_Id;
Layout_Done : Boolean;
Default : Alignment_Result) return Alignment_Result;
-- This is the internal recursive function that actually does the work.
-- There is one additional parameter, which says what the result should
-- be if no alignment information is found, and there is no definite
......@@ -8387,9 +8389,10 @@ package body Sem_Util is
---------------------------------------
function Has_Compatible_Alignment_Internal
(Obj : Entity_Id;
Expr : Node_Id;
Default : Alignment_Result) return Alignment_Result
(Obj : Entity_Id;
Expr : Node_Id;
Layout_Done : Boolean;
Default : Alignment_Result) return Alignment_Result
is
Result : Alignment_Result := Known_Compatible;
-- Holds the current status of the result. Note that once a value of
......@@ -8439,14 +8442,14 @@ package body Sem_Util is
then
Set_Result
(Has_Compatible_Alignment_Internal
(Obj, Prefix (Expr), Known_Compatible));
(Obj, Prefix (Expr), Layout_Done, Known_Compatible));
-- In all other cases, we need a full check on the prefix
else
Set_Result
(Has_Compatible_Alignment_Internal
(Obj, Prefix (Expr), Unknown));
(Obj, Prefix (Expr), Layout_Done, Unknown));
end if;
end Check_Prefix;
......@@ -8465,14 +8468,14 @@ package body Sem_Util is
begin
-- If Expr is a selected component, we must make sure there is no
-- potentially troublesome component clause, and that the record is
-- not packed.
-- potentially troublesome component clause and that the record is
-- not packed if the layout is not done.
if Nkind (Expr) = N_Selected_Component then
-- Packed record always generate unknown alignment
-- Packing generates unknown alignment if layout is not done
if Is_Packed (Etype (Prefix (Expr))) then
if Is_Packed (Etype (Prefix (Expr))) and then not Layout_Done then
Set_Result (Unknown);
end if;
......@@ -8483,7 +8486,7 @@ package body Sem_Util is
-- If Expr is an indexed component, we must make sure there is no
-- potentially troublesome Component_Size clause and that the array
-- is not bit-packed.
-- is not bit-packed if the layout is not done.
elsif Nkind (Expr) = N_Indexed_Component then
declare
......@@ -8491,9 +8494,9 @@ package body Sem_Util is
Ind : constant Node_Id := First_Index (Typ);
begin
-- Bit packed array always generates unknown alignment
-- Packing generates unknown alignment if layout is not done
if Is_Bit_Packed_Array (Typ) then
if Is_Bit_Packed_Array (Typ) and then not Layout_Done then
Set_Result (Unknown);
end if;
......@@ -8695,7 +8698,8 @@ package body Sem_Util is
-- Now do the internal call that does all the work
return Has_Compatible_Alignment_Internal (Obj, Expr, Unknown);
return
Has_Compatible_Alignment_Internal (Obj, Expr, Layout_Done, Unknown);
end Has_Compatible_Alignment;
----------------------
......
gcc/ada/sem_util.ads
......@@ -991,17 +991,21 @@ package Sem_Util is
-- that the values are arranged in increasing order of problematicness.
function Has_Compatible_Alignment
(Obj : Entity_Id;
Expr : Node_Id) return Alignment_Result;
(Obj : Entity_Id;
Expr : Node_Id;
Layout_Done : Boolean) return Alignment_Result;
-- Obj is an object entity, and expr is a node for an object reference. If
-- the alignment of the object referenced by Expr is known to be compatible
-- with the alignment of Obj (i.e. is larger or the same), then the result
-- is Known_Compatible. If the alignment of the object referenced by Expr
-- is known to be less than the alignment of Obj, then Known_Incompatible
-- is returned. If neither condition can be reliably established at compile
-- time, then Unknown is returned. This is used to determine if alignment
-- checks are required for address clauses, and also whether copies must
-- be made when objects are passed by reference.
-- time, then Unknown is returned. If Layout_Done is True, the function can
-- assume that the information on size and alignment of types and objects
-- is present in the tree. This is used to determine if alignment checks
-- are required for address clauses (Layout_Done is False in this case) as
-- well as to issue appropriate warnings for them in the post compilation
-- phase (Layout_Done is True in this case).
--
-- Note: Known_Incompatible does not mean that at run time the alignment
-- of Expr is known to be wrong for Obj, just that it can be determined
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment