Commit ab9e2084 by Eric Botcazou Committed by Pierre-Marie de Rodat

[Ada] Get rid of spurious error for _Tag on extension with reverse bit order

2019-10-10  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* sem_ch13.adb (Adjust_Record_For_Reverse_Bit_Order): Do not use
	the Esize of the component to compute its layout, but only the
	Component_Clause.  Do not issue a warning for the _Tag
	component.  Also set the Esize of the component at the end of
	the layout.
	(Analyze_Record_Representation_Clause): Remove Hbit local
	variable.  Lay out the Original_Record_Component only if it's
	distinct from the component.
	(Check_Record_Representation_Clause): Fix off-by-one bug for the
	Last_Bit of the artificial clause built for the _Tag component.

From-SVN: r276827
parent a871b0aa
2019-10-10 Bob Duff <duff@adacore.com> 2019-10-10 Eric Botcazou <ebotcazou@adacore.com>
* treepr.ads, treepr.adb (ppar): New procedure. * sem_ch13.adb (Adjust_Record_For_Reverse_Bit_Order): Do not use
\ No newline at end of file the Esize of the component to compute its layout, but only the
Component_Clause. Do not issue a warning for the _Tag
component. Also set the Esize of the component at the end of
the layout.
(Analyze_Record_Representation_Clause): Remove Hbit local
variable. Lay out the Original_Record_Component only if it's
distinct from the component.
(Check_Record_Representation_Clause): Fix off-by-one bug for the
Last_Bit of the artificial clause built for the _Tag component.
\ No newline at end of file
...@@ -360,11 +360,11 @@ package body Sem_Ch13 is ...@@ -360,11 +360,11 @@ package body Sem_Ch13 is
Num_CC : Natural; Num_CC : Natural;
begin begin
-- Processing here used to depend on Ada version: the behavior was -- The processing done here used to depend on the Ada version, but the
-- changed by AI95-0133. However this AI is a Binding interpretation, -- behavior has been changed by AI95-0133. However this AI is a Binding
-- so we now implement it even in Ada 95 mode. The original behavior -- Interpretation, so we now implement it even in Ada 95 mode. But the
-- from unamended Ada 95 is still available for compatibility under -- original behavior from unamended Ada 95 is available for the sake of
-- debugging switch -gnatd. -- compatibility under the debugging switch -gnatd.p in Ada 95 mode.
if Ada_Version < Ada_2005 and then Debug_Flag_Dot_P then if Ada_Version < Ada_2005 and then Debug_Flag_Dot_P then
Adjust_Record_For_Reverse_Bit_Order_Ada_95 (R); Adjust_Record_For_Reverse_Bit_Order_Ada_95 (R);
...@@ -376,6 +376,11 @@ package body Sem_Ch13 is ...@@ -376,6 +376,11 @@ package body Sem_Ch13 is
-- same byte offset and processing them together. Same approach is still -- same byte offset and processing them together. Same approach is still
-- valid in later versions including Ada 2012. -- valid in later versions including Ada 2012.
-- Note that component clauses found on record types may be inherited,
-- in which case the layout of the component with such a clause still
-- has to be done at this point. Therefore, the processing done here
-- must exclusively rely on the Component_Clause of the component.
-- This first loop through components does two things. First it deals -- This first loop through components does two things. First it deals
-- with the case of components with component clauses whose length is -- with the case of components with component clauses whose length is
-- greater than the maximum machine scalar size (either accepting them -- greater than the maximum machine scalar size (either accepting them
...@@ -616,13 +621,19 @@ package body Sem_Ch13 is ...@@ -616,13 +621,19 @@ package body Sem_Ch13 is
Comp : constant Entity_Id := Comps (C); Comp : constant Entity_Id := Comps (C);
CC : constant Node_Id := Component_Clause (Comp); CC : constant Node_Id := Component_Clause (Comp);
FB : constant Uint := Static_Integer (First_Bit (CC));
LB : constant Uint := Static_Integer (Last_Bit (CC)); LB : constant Uint := Static_Integer (Last_Bit (CC));
NFB : constant Uint := MSS - Uint_1 - LB; NFB : constant Uint := MSS - 1 - LB;
NLB : constant Uint := NFB + Esize (Comp) - 1; NLB : constant Uint := NFB + LB - FB;
Pos : constant Uint := Static_Integer (Position (CC)); Pos : constant Uint := Static_Integer (Position (CC));
begin begin
if Warn_On_Reverse_Bit_Order then -- Do not warn for the artificial clause built for the tag
-- in Check_Record_Representation_Clause if it is inherited.
if Warn_On_Reverse_Bit_Order
and then Chars (Comp) /= Name_uTag
then
Error_Msg_Uint_1 := MSS; Error_Msg_Uint_1 := MSS;
Error_Msg_N Error_Msg_N
("info: reverse bit order in machine scalar of " ("info: reverse bit order in machine scalar of "
...@@ -642,8 +653,9 @@ package body Sem_Ch13 is ...@@ -642,8 +653,9 @@ package body Sem_Ch13 is
end if; end if;
Set_Component_Bit_Offset (Comp, Pos * SSU + NFB); Set_Component_Bit_Offset (Comp, Pos * SSU + NFB);
Set_Normalized_Position (Comp, Pos + NFB / SSU); Set_Esize (Comp, 1 + (NLB - NFB));
Set_Normalized_First_Bit (Comp, NFB mod SSU); Set_Normalized_First_Bit (Comp, NFB mod SSU);
Set_Normalized_Position (Comp, Pos + NFB / SSU);
end; end;
end loop; end loop;
end loop; end loop;
...@@ -6937,7 +6949,6 @@ package body Sem_Ch13 is ...@@ -6937,7 +6949,6 @@ package body Sem_Ch13 is
CC : Node_Id; CC : Node_Id;
Comp : Entity_Id; Comp : Entity_Id;
Fbit : Uint; Fbit : Uint;
Hbit : Uint := Uint_0;
Lbit : Uint; Lbit : Uint;
Ocomp : Entity_Id; Ocomp : Entity_Id;
Posit : Uint; Posit : Uint;
...@@ -7263,6 +7274,9 @@ package body Sem_Ch13 is ...@@ -7263,6 +7274,9 @@ package body Sem_Ch13 is
Set_Normalized_First_Bit (Comp, Fbit mod SSU); Set_Normalized_First_Bit (Comp, Fbit mod SSU);
Set_Normalized_Position (Comp, Fbit / SSU); Set_Normalized_Position (Comp, Fbit / SSU);
Set_Normalized_Position_Max
(Comp, Normalized_Position (Comp));
if Warn_On_Overridden_Size if Warn_On_Overridden_Size
and then Has_Size_Clause (Etype (Comp)) and then Has_Size_Clause (Etype (Comp))
and then RM_Size (Etype (Comp)) /= Esize (Comp) and then RM_Size (Etype (Comp)) /= Esize (Comp)
...@@ -7272,16 +7286,6 @@ package body Sem_Ch13 is ...@@ -7272,16 +7286,6 @@ package body Sem_Ch13 is
Component_Name (CC), Etype (Comp)); Component_Name (CC), Etype (Comp));
end if; end if;
-- This information is also set in the corresponding
-- component of the base type, found by accessing the
-- Original_Record_Component link if it is present.
Ocomp := Original_Record_Component (Comp);
if Hbit < Lbit then
Hbit := Lbit;
end if;
Check_Size Check_Size
(Component_Name (CC), (Component_Name (CC),
Etype (Comp), Etype (Comp),
...@@ -7291,12 +7295,18 @@ package body Sem_Ch13 is ...@@ -7291,12 +7295,18 @@ package body Sem_Ch13 is
Set_Biased Set_Biased
(Comp, First_Node (CC), "component clause", Biased); (Comp, First_Node (CC), "component clause", Biased);
if Present (Ocomp) then -- This information is also set in the corresponding
-- component of the base type, found by accessing the
-- Original_Record_Component link if it is present.
Ocomp := Original_Record_Component (Comp);
if Present (Ocomp) and then Ocomp /= Comp then
Set_Component_Clause (Ocomp, CC); Set_Component_Clause (Ocomp, CC);
Set_Component_Bit_Offset (Ocomp, Fbit); Set_Component_Bit_Offset (Ocomp, Fbit);
Set_Esize (Ocomp, 1 + (Lbit - Fbit));
Set_Normalized_First_Bit (Ocomp, Fbit mod SSU); Set_Normalized_First_Bit (Ocomp, Fbit mod SSU);
Set_Normalized_Position (Ocomp, Fbit / SSU); Set_Normalized_Position (Ocomp, Fbit / SSU);
Set_Esize (Ocomp, 1 + (Lbit - Fbit));
Set_Normalized_Position_Max Set_Normalized_Position_Max
(Ocomp, Normalized_Position (Ocomp)); (Ocomp, Normalized_Position (Ocomp));
...@@ -10616,7 +10626,7 @@ package body Sem_Ch13 is ...@@ -10616,7 +10626,7 @@ package body Sem_Ch13 is
First_Bit => Make_Integer_Literal (Loc, Uint_0), First_Bit => Make_Integer_Literal (Loc, Uint_0),
Last_Bit => Last_Bit =>
Make_Integer_Literal (Loc, Make_Integer_Literal (Loc,
UI_From_Int (System_Address_Size)))); UI_From_Int (System_Address_Size - 1))));
Ccount := Ccount + 1; Ccount := Ccount + 1;
end if; end if;
......
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