-- 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 --
-----------------------------
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
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
projects / gcc.git / commitdiff