OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

freeze.adb (Check_Component_Storage_Order): Fix enforcement of nesting rules for composites with different SSOs.

Browse Source 
2014-07-18  Thomas Quinot  <quinot@adacore.com>

	* freeze.adb (Check_Component_Storage_Order): Fix enforcement
	of nesting rules for composites with different SSOs.

2014-07-18  Thomas Quinot  <quinot@adacore.com>

	* par_sco.adb (Is_Logical_Operator): An If_Expression is not
	a proper logical operator.
	(Has_Decision): An If_Expression indicates the presence of a decision
	although it is not a logical operator.

From-SVN: r212793
This commit is contained in:
Thomas Quinot 2014-07-18 09:39:09 +00:00 committed by Arnaud Charlet
parent 783d035ba7
commit e191e5aecc
3 changed files with 63 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/ada/ChangeLog
View File

@ -1,3 +1,15 @@
2014-07-18 Thomas Quinot <quinot@adacore.com>
* freeze.adb (Check_Component_Storage_Order): Fix enforcement
of nesting rules for composites with different SSOs.
2014-07-18 Thomas Quinot <quinot@adacore.com>
* par_sco.adb (Is_Logical_Operator): An If_Expression is not
a proper logical operator.
(Has_Decision): An If_Expression indicates the presence of a decision
although it is not a logical operator.
2014-07-18 Robert Dewar <dewar@adacore.com>
* gnat_ugn.texi: Remove note that -gnatR not allowed with -gnatc.

46
gcc/ada/freeze.adb
View File

@ -1086,7 +1086,7 @@ package body Freeze is
Err_Node : Node_Id;
Comp_Byte_Aligned : Boolean;
-- Set True for the record case, when Comp starts on a byte boundary
-- Set for the record case, True if Comp starts on a byte boundary
-- (in which case it is allowed to have different storage order).
Comp_SSO_Differs : Boolean;
@ -1095,6 +1095,20 @@ package body Freeze is
Component_Aliased : Boolean;
function Is_Packed_Array (T : Entity_Id) return Boolean;
-- True for a packed array type
---------------------
-- Is_Packed_Array --
---------------------
function Is_Packed_Array (T : Entity_Id) return Boolean is
begin
return Is_Array_Type (T) and then Is_Packed (T);
end Is_Packed_Array;
-- Start of processing for Check_Component_Storage_Order
begin
-- Record case
@ -1107,10 +1121,18 @@ package body Freeze is
Component_Aliased := False;
else
Comp_Byte_Aligned :=
Present (Component_Clause (Comp))
and then
Normalized_First_Bit (Comp) mod System_Storage_Unit = 0;
-- If a component clause is present, check whether component
-- starts on a storage element boundary. Otherwise conservatively
-- assume it does so only in the case where the record is not
-- packed.
if Present (Component_Clause (Comp)) then
Comp_Byte_Aligned :=
Normalized_First_Bit (Comp) mod System_Storage_Unit = 0;
else
Comp_Byte_Aligned := not Is_Packed (Encl_Type);
end if;
Component_Aliased := Is_Aliased (Comp);
end if;
@ -1120,7 +1142,6 @@ package body Freeze is
Err_Node := Encl_Type;
Comp_Type := Component_Type (Encl_Type);
Comp_Byte_Aligned := False;
Component_Aliased := Has_Aliased_Components (Encl_Type);
end if;
@ -1167,14 +1188,23 @@ package body Freeze is
-- Reject if component is a packed array, as it may be represented
-- as a scalar internally.
if Is_Packed (Comp_Type) then
if Is_Packed_Array (Comp_Type) then
Error_Msg_N
("type of packed component must have same scalar "
& "storage order as enclosing composite", Err_Node);
-- Reject if composite is a packed array, as it may be rewritten
-- into an array of scalars.
elsif Is_Packed_Array (Encl_Type) then
Error_Msg_N ("type of packed array must have same scalar "
& "storage order as component", Err_Node);
-- Reject if not byte aligned
elsif not Comp_Byte_Aligned then
elsif Is_Record_Type (Encl_Type)
and then not Comp_Byte_Aligned
then
Error_Msg_N
("type of non-byte-aligned component must have same scalar "
& "storage order as enclosing composite", Err_Node);

21
gcc/ada/par_sco.adb
View File

@ -100,10 +100,10 @@ package body Par_SCO is
-- contains a logical operator in its subtree).
function Is_Logical_Operator (N : Node_Id) return Boolean;
-- N is the node for a subexpression. This procedure just tests N to see
-- if it is a logical operator (including short circuit conditions, but
-- excluding OR and AND) and returns True if so. It also returns True for
-- an if expression. False in all other cases, no other processing is done.
-- N is the node for a subexpression. This procedure determines whether N
-- a logical operator (including short circuit conditions, but excluding
-- OR and AND) and returns True if so. Note that in cases where True is
-- returned, callers assume Nkind (N) in N_Op.
function To_Source_Location (S : Source_Ptr) return Source_Location;
-- Converts Source_Ptr value to Source_Location (line/col) format
@ -307,6 +307,9 @@ package body Par_SCO is
function Has_Decision (N : Node_Id) return Boolean is
function Check_Node (N : Node_Id) return Traverse_Result;
-- Determine if Nkind (N) indicates the presence of a decision (i.e.
-- N is a logical operator -- a decision in itelsf -- or an
-- IF-expression -- whose Condition attribute is a decision).
----------------
-- Check_Node --
@ -314,7 +317,7 @@ package body Par_SCO is
function Check_Node (N : Node_Id) return Traverse_Result is
begin
if Is_Logical_Operator (N) then
if Is_Logical_Operator (N) or else Nkind (N) = N_If_Expression then
return Abandon;
else
return OK;
@ -346,7 +349,8 @@ package body Par_SCO is
begin
SCO_Unit_Number_Table.Init;
-- Set dummy 0'th entry in place for sort
-- The SCO_Unit_Number_Table entry with index 0 is intentionally set
-- aside to be used as temporary for sorting.
SCO_Unit_Number_Table.Increment_Last;
end Initialize;
@ -357,7 +361,7 @@ package body Par_SCO is
function Is_Logical_Operator (N : Node_Id) return Boolean is
begin
return Nkind_In (N, N_Op_Not, N_And_Then, N_Or_Else, N_If_Expression);
return Nkind_In (N, N_Op_Not, N_And_Then, N_Or_Else);
end Is_Logical_Operator;
-----------------------
@ -456,7 +460,8 @@ package body Par_SCO is
if Nkind_In (N, N_Op_Or, N_Or_Else) then
C := '|';
else
else pragma Assert (Nkind_In (N, N_Op_And, N_And_Then));
C := '&';
end if;
end if;