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

[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:
Bob Duff 2019-08-19 08:36:35 +00:00 committed by Pierre-Marie de Rodat
parent eb6b9c9bcb
commit d403cfad2f
2 changed files with 243 additions and 184 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/ada/ChangeLog
View File

@ -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

419
gcc/ada/sem_ch13.adb
View File

@ -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