[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

2 files changed, 243 insertions, 184 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 6f31df1..f6e0085 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 92e308a..a3a7be7 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -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