[Ada] Process type extensions for -gnatw.h
This patch enables gap detection in type extensions. With the -gnatw.h switch, on 64-bit machines, the following test should get warnings: gcc -c gaps.ads -gnatw.h gaps.ads:16:07: warning: 48-bit gap before component "Comp2" gaps.ads:17:07: warning: 8-bit gap before component "Comp3" package Gaps is type Integer_16 is mod 2**16; type TestGap is tagged record Comp1 : Integer_16; end record; for TestGap use record Comp1 at 0 + 8 range 0..15; end record; type TestGap2 is new TestGap with record Comp2 : Integer_16; Comp3 : Integer_16; end record; for TestGap2 use record Comp2 at 08 + 8 range 0..15; Comp3 at 11 + 8 range 0..15; end record; end Gaps; 2019-08-19 Bob Duff <duff@adacore.com> gcc/ada/ * sem_ch13.adb (Record_Hole_Check): Procedure to check for holes that incudes processing type extensions. A type extension is processed by first calling Record_Hole_Check recursively on the parent type to compute the bit number after the last component of the parent. From-SVN: r274653
This commit is contained in:
parent
eb6b9c9bcb
commit
d403cfad2f
@ -1,3 +1,11 @@
|
||||
2019-08-19 Bob Duff <duff@adacore.com>
|
||||
|
||||
* sem_ch13.adb (Record_Hole_Check): Procedure to check for holes
|
||||
that incudes processing type extensions. A type extension is
|
||||
processed by first calling Record_Hole_Check recursively on the
|
||||
parent type to compute the bit number after the last component
|
||||
of the parent.
|
||||
|
||||
2019-08-19 Gary Dismukes <dismukes@adacore.com>
|
||||
|
||||
* checks.adb (Length_Mismatch_Info_Message): New function in
|
||||
|
@ -10122,6 +10122,14 @@ package body Sem_Ch13 is
|
||||
-- issued, since the message was already given. Comp is also set to
|
||||
-- Empty if the current "component clause" is in fact a pragma.
|
||||
|
||||
procedure Record_Hole_Check
|
||||
(Rectype : Entity_Id; After_Last : out Uint; Warn : Boolean);
|
||||
-- Checks for gaps in the given Rectype. Compute After_Last, the bit
|
||||
-- number after the last component. Warn is True on the initial call,
|
||||
-- and warnings are given for gaps. For a type extension, this is called
|
||||
-- recursively to compute After_Last for the parent type; in this case
|
||||
-- Warn is False and the warnings are suppressed.
|
||||
|
||||
-----------------------------
|
||||
-- Check_Component_Overlap --
|
||||
-----------------------------
|
||||
@ -10233,6 +10241,225 @@ package body Sem_Ch13 is
|
||||
end if;
|
||||
end Find_Component;
|
||||
|
||||
-----------------------
|
||||
-- Record_Hole_Check --
|
||||
-----------------------
|
||||
|
||||
procedure Record_Hole_Check
|
||||
(Rectype : Entity_Id; After_Last : out Uint; Warn : Boolean)
|
||||
is
|
||||
Decl : constant Node_Id := Declaration_Node (Base_Type (Rectype));
|
||||
-- Full declaration of record type
|
||||
|
||||
procedure Check_Component_List
|
||||
(DS : List_Id;
|
||||
CL : Node_Id;
|
||||
Sbit : Uint;
|
||||
Abit : out Uint);
|
||||
-- Check component list CL for holes. DS is a list of discriminant
|
||||
-- specifications to be included in the consideration of components.
|
||||
-- Sbit is the starting bit, which is zero if there are no preceding
|
||||
-- components (before a variant part, or a parent type, or a tag
|
||||
-- field). If there are preceding components, Sbit is the bit just
|
||||
-- after the last such component. Abit is set to the bit just after
|
||||
-- the last component of DS and CL.
|
||||
|
||||
--------------------------
|
||||
-- Check_Component_List --
|
||||
--------------------------
|
||||
|
||||
procedure Check_Component_List
|
||||
(DS : List_Id;
|
||||
CL : Node_Id;
|
||||
Sbit : Uint;
|
||||
Abit : out Uint)
|
||||
is
|
||||
Compl : Integer;
|
||||
|
||||
begin
|
||||
Compl := Integer (List_Length (Component_Items (CL)));
|
||||
|
||||
if DS /= No_List then
|
||||
Compl := Compl + Integer (List_Length (DS));
|
||||
end if;
|
||||
|
||||
declare
|
||||
Comps : array (Natural range 0 .. Compl) of Entity_Id;
|
||||
-- Gather components (zero entry is for sort routine)
|
||||
|
||||
Ncomps : Natural := 0;
|
||||
-- Number of entries stored in Comps (starting at Comps (1))
|
||||
|
||||
Citem : Node_Id;
|
||||
-- One component item or discriminant specification
|
||||
|
||||
Nbit : Uint;
|
||||
-- Starting bit for next component
|
||||
|
||||
CEnt : Entity_Id;
|
||||
-- Component entity
|
||||
|
||||
Variant : Node_Id;
|
||||
-- One variant
|
||||
|
||||
function Lt (Op1, Op2 : Natural) return Boolean;
|
||||
-- Compare routine for Sort
|
||||
|
||||
procedure Move (From : Natural; To : Natural);
|
||||
-- Move routine for Sort
|
||||
|
||||
package Sorting is new GNAT.Heap_Sort_G (Move, Lt);
|
||||
|
||||
--------
|
||||
-- Lt --
|
||||
--------
|
||||
|
||||
function Lt (Op1, Op2 : Natural) return Boolean is
|
||||
begin
|
||||
return Component_Bit_Offset (Comps (Op1))
|
||||
< Component_Bit_Offset (Comps (Op2));
|
||||
end Lt;
|
||||
|
||||
----------
|
||||
-- Move --
|
||||
----------
|
||||
|
||||
procedure Move (From : Natural; To : Natural) is
|
||||
begin
|
||||
Comps (To) := Comps (From);
|
||||
end Move;
|
||||
|
||||
begin
|
||||
-- Gather discriminants into Comp
|
||||
|
||||
if DS /= No_List then
|
||||
Citem := First (DS);
|
||||
while Present (Citem) loop
|
||||
if Nkind (Citem) = N_Discriminant_Specification then
|
||||
declare
|
||||
Ent : constant Entity_Id :=
|
||||
Defining_Identifier (Citem);
|
||||
begin
|
||||
if Ekind (Ent) = E_Discriminant then
|
||||
Ncomps := Ncomps + 1;
|
||||
Comps (Ncomps) := Ent;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
||||
Next (Citem);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
-- Gather component entities into Comp
|
||||
|
||||
Citem := First (Component_Items (CL));
|
||||
while Present (Citem) loop
|
||||
if Nkind (Citem) = N_Component_Declaration then
|
||||
Ncomps := Ncomps + 1;
|
||||
Comps (Ncomps) := Defining_Identifier (Citem);
|
||||
end if;
|
||||
|
||||
Next (Citem);
|
||||
end loop;
|
||||
|
||||
-- Now sort the component entities based on the first bit.
|
||||
-- Note we already know there are no overlapping components.
|
||||
|
||||
Sorting.Sort (Ncomps);
|
||||
|
||||
-- Loop through entries checking for holes
|
||||
|
||||
Nbit := Sbit;
|
||||
for J in 1 .. Ncomps loop
|
||||
CEnt := Comps (J);
|
||||
|
||||
declare
|
||||
CBO : constant Uint := Component_Bit_Offset (CEnt);
|
||||
|
||||
begin
|
||||
-- Skip components with unknown offsets
|
||||
|
||||
if CBO /= No_Uint and then CBO >= 0 then
|
||||
Error_Msg_Uint_1 := CBO - Nbit;
|
||||
|
||||
if Warn and then Error_Msg_Uint_1 > 0 then
|
||||
Error_Msg_NE
|
||||
("?H?^-bit gap before component&",
|
||||
Component_Name (Component_Clause (CEnt)),
|
||||
CEnt);
|
||||
end if;
|
||||
|
||||
Nbit := CBO + Esize (CEnt);
|
||||
end if;
|
||||
end;
|
||||
end loop;
|
||||
|
||||
-- Set Abit to just after the last nonvariant component
|
||||
|
||||
Abit := Nbit;
|
||||
|
||||
-- Process variant parts recursively if present. Set Abit to
|
||||
-- the maximum for all variant parts.
|
||||
|
||||
if Present (Variant_Part (CL)) then
|
||||
declare
|
||||
Var_Start : constant Uint := Nbit;
|
||||
begin
|
||||
Variant := First (Variants (Variant_Part (CL)));
|
||||
while Present (Variant) loop
|
||||
Check_Component_List
|
||||
(No_List, Component_List (Variant), Var_Start, Nbit);
|
||||
Next (Variant);
|
||||
if Nbit > Abit then
|
||||
Abit := Nbit;
|
||||
end if;
|
||||
end loop;
|
||||
end;
|
||||
end if;
|
||||
end;
|
||||
end Check_Component_List;
|
||||
|
||||
Sbit : Uint;
|
||||
-- Starting bit for call to Check_Component_List. Zero for an
|
||||
-- untagged type. The size of the Tag for a nonderived tagged
|
||||
-- type. Parent size for a type extension.
|
||||
|
||||
Record_Definition : Node_Id;
|
||||
-- Record_Definition containing Component_List to pass to
|
||||
-- Check_Component_List.
|
||||
|
||||
-- Start of processing for Record_Hole_Check
|
||||
|
||||
begin
|
||||
if Is_Tagged_Type (Rectype) then
|
||||
Sbit := UI_From_Int (System_Address_Size);
|
||||
else
|
||||
Sbit := Uint_0;
|
||||
end if;
|
||||
|
||||
if Nkind (Decl) = N_Full_Type_Declaration then
|
||||
Record_Definition := Type_Definition (Decl);
|
||||
|
||||
-- If we have a record extension, set Sbit to point after the last
|
||||
-- component of the parent type, by calling Record_Hole_Check
|
||||
-- recursively.
|
||||
|
||||
if Nkind (Record_Definition) = N_Derived_Type_Definition then
|
||||
Record_Definition := Record_Extension_Part (Record_Definition);
|
||||
Record_Hole_Check (Underlying_Type (Parent_Subtype (Rectype)),
|
||||
After_Last => Sbit, Warn => False);
|
||||
end if;
|
||||
|
||||
if Nkind (Record_Definition) = N_Record_Definition then
|
||||
Check_Component_List
|
||||
(Discriminant_Specifications (Decl),
|
||||
Component_List (Record_Definition),
|
||||
Sbit, After_Last);
|
||||
end if;
|
||||
end if;
|
||||
end Record_Hole_Check;
|
||||
|
||||
-- Start of processing for Check_Record_Representation_Clause
|
||||
|
||||
begin
|
||||
@ -10589,192 +10816,16 @@ package body Sem_Ch13 is
|
||||
end Overlap_Check2;
|
||||
end if;
|
||||
|
||||
-- The following circuit deals with warning on record holes (gaps). We
|
||||
-- skip this check if overlap was detected, since it makes sense for the
|
||||
-- programmer to fix this illegality before worrying about warnings.
|
||||
|
||||
if not Overlap_Detected and Warn_On_Record_Holes then
|
||||
Record_Hole_Check : declare
|
||||
Decl : constant Node_Id := Declaration_Node (Base_Type (Rectype));
|
||||
-- Full declaration of record type
|
||||
|
||||
procedure Check_Component_List
|
||||
(CL : Node_Id;
|
||||
Sbit : Uint;
|
||||
DS : List_Id);
|
||||
-- Check component list CL for holes. The starting bit should be
|
||||
-- Sbit. which is zero for the main record component list and set
|
||||
-- appropriately for recursive calls for variants. DS is set to
|
||||
-- a list of discriminant specifications to be included in the
|
||||
-- consideration of components. It is No_List if none to consider.
|
||||
|
||||
--------------------------
|
||||
-- Check_Component_List --
|
||||
--------------------------
|
||||
|
||||
procedure Check_Component_List
|
||||
(CL : Node_Id;
|
||||
Sbit : Uint;
|
||||
DS : List_Id)
|
||||
is
|
||||
Compl : Integer;
|
||||
|
||||
begin
|
||||
Compl := Integer (List_Length (Component_Items (CL)));
|
||||
|
||||
if DS /= No_List then
|
||||
Compl := Compl + Integer (List_Length (DS));
|
||||
end if;
|
||||
|
||||
declare
|
||||
Comps : array (Natural range 0 .. Compl) of Entity_Id;
|
||||
-- Gather components (zero entry is for sort routine)
|
||||
|
||||
Ncomps : Natural := 0;
|
||||
-- Number of entries stored in Comps (starting at Comps (1))
|
||||
|
||||
Citem : Node_Id;
|
||||
-- One component item or discriminant specification
|
||||
|
||||
Nbit : Uint;
|
||||
-- Starting bit for next component
|
||||
|
||||
CEnt : Entity_Id;
|
||||
-- Component entity
|
||||
|
||||
Variant : Node_Id;
|
||||
-- One variant
|
||||
|
||||
function Lt (Op1, Op2 : Natural) return Boolean;
|
||||
-- Compare routine for Sort
|
||||
|
||||
procedure Move (From : Natural; To : Natural);
|
||||
-- Move routine for Sort
|
||||
|
||||
package Sorting is new GNAT.Heap_Sort_G (Move, Lt);
|
||||
|
||||
--------
|
||||
-- Lt --
|
||||
--------
|
||||
|
||||
function Lt (Op1, Op2 : Natural) return Boolean is
|
||||
begin
|
||||
return Component_Bit_Offset (Comps (Op1))
|
||||
<
|
||||
Component_Bit_Offset (Comps (Op2));
|
||||
end Lt;
|
||||
|
||||
----------
|
||||
-- Move --
|
||||
----------
|
||||
|
||||
procedure Move (From : Natural; To : Natural) is
|
||||
begin
|
||||
Comps (To) := Comps (From);
|
||||
end Move;
|
||||
|
||||
begin
|
||||
-- Gather discriminants into Comp
|
||||
|
||||
if DS /= No_List then
|
||||
Citem := First (DS);
|
||||
while Present (Citem) loop
|
||||
if Nkind (Citem) = N_Discriminant_Specification then
|
||||
declare
|
||||
Ent : constant Entity_Id :=
|
||||
Defining_Identifier (Citem);
|
||||
begin
|
||||
if Ekind (Ent) = E_Discriminant then
|
||||
Ncomps := Ncomps + 1;
|
||||
Comps (Ncomps) := Ent;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
||||
Next (Citem);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
-- Gather component entities into Comp
|
||||
|
||||
Citem := First (Component_Items (CL));
|
||||
while Present (Citem) loop
|
||||
if Nkind (Citem) = N_Component_Declaration then
|
||||
Ncomps := Ncomps + 1;
|
||||
Comps (Ncomps) := Defining_Identifier (Citem);
|
||||
end if;
|
||||
|
||||
Next (Citem);
|
||||
end loop;
|
||||
|
||||
-- Now sort the component entities based on the first bit.
|
||||
-- Note we already know there are no overlapping components.
|
||||
|
||||
Sorting.Sort (Ncomps);
|
||||
|
||||
-- Loop through entries checking for holes
|
||||
|
||||
Nbit := Sbit;
|
||||
for J in 1 .. Ncomps loop
|
||||
CEnt := Comps (J);
|
||||
|
||||
declare
|
||||
CBO : constant Uint := Component_Bit_Offset (CEnt);
|
||||
|
||||
begin
|
||||
-- Skip components with unknown offsets
|
||||
|
||||
if CBO /= No_Uint and then CBO >= 0 then
|
||||
Error_Msg_Uint_1 := CBO - Nbit;
|
||||
|
||||
if Error_Msg_Uint_1 > 0 then
|
||||
Error_Msg_NE
|
||||
("?H?^-bit gap before component&",
|
||||
Component_Name (Component_Clause (CEnt)),
|
||||
CEnt);
|
||||
end if;
|
||||
|
||||
Nbit := CBO + Esize (CEnt);
|
||||
end if;
|
||||
end;
|
||||
end loop;
|
||||
|
||||
-- Process variant parts recursively if present
|
||||
|
||||
if Present (Variant_Part (CL)) then
|
||||
Variant := First (Variants (Variant_Part (CL)));
|
||||
while Present (Variant) loop
|
||||
Check_Component_List
|
||||
(Component_List (Variant), Nbit, No_List);
|
||||
Next (Variant);
|
||||
end loop;
|
||||
end if;
|
||||
end;
|
||||
end Check_Component_List;
|
||||
|
||||
-- Start of processing for Record_Hole_Check
|
||||
-- Check for record holes (gaps). We skip this check if overlap was
|
||||
-- detected, since it makes sense for the programmer to fix this
|
||||
-- error before worrying about warnings.
|
||||
|
||||
if Warn_On_Record_Holes and not Overlap_Detected then
|
||||
declare
|
||||
Ignore : Uint;
|
||||
begin
|
||||
declare
|
||||
Sbit : Uint;
|
||||
|
||||
begin
|
||||
if Is_Tagged_Type (Rectype) then
|
||||
Sbit := UI_From_Int (System_Address_Size);
|
||||
else
|
||||
Sbit := Uint_0;
|
||||
end if;
|
||||
|
||||
if Nkind (Decl) = N_Full_Type_Declaration
|
||||
and then Nkind (Type_Definition (Decl)) = N_Record_Definition
|
||||
then
|
||||
Check_Component_List
|
||||
(Component_List (Type_Definition (Decl)),
|
||||
Sbit,
|
||||
Discriminant_Specifications (Decl));
|
||||
end if;
|
||||
end;
|
||||
end Record_Hole_Check;
|
||||
Record_Hole_Check (Rectype, After_Last => Ignore, Warn => True);
|
||||
end;
|
||||
end if;
|
||||
|
||||
-- For records that have component clauses for all components, and whose
|
||||
|
Loading…
Reference in New Issue
Block a user