[multiple changes]

2010-09-10  Robert Dewar  <dewar@adacore.com>

	* sem_ch13.adb (Check_Record_Representation_Clause): Implement record
	gap warnings.
	* sem_warn.ads, sem_warn.adb (Warn_On_Record_Holes): New warning flag.
	* usage.adb: Add lines for -gnatw.h/H
	* gnat_ugn.texi: Add documentation for J519-010
	Warn on record holes/gaps
	* ug_words: Add entries for -gnatw.h/-gnatw.H
	* vms_data.ads: Add entries for [NO]AVOIDGAPS

2010-09-10  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch6.adb: Update comment.

From-SVN: r164186

9 files changed, 264 insertions, 15 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d093901..454478f 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,18 @@
+2010-09-10  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch13.adb (Check_Record_Representation_Clause): Implement record
+	gap warnings.
+	* sem_warn.ads, sem_warn.adb (Warn_On_Record_Holes): New warning flag.
+	* usage.adb: Add lines for -gnatw.h/H
+	* gnat_ugn.texi: Add documentation for J519-010
+	Warn on record holes/gaps
+	* ug_words: Add entries for -gnatw.h/-gnatw.H
+	* vms_data.ads: Add entries for [NO]AVOIDGAPS
+
+2010-09-10  Gary Dismukes  <dismukes@adacore.com>
+
+	* sem_ch6.adb: Update comment.
+
 2010-09-10  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch3.adb (Build_Derived_Private_Type): Mark generated declaration
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index e22ac66..694c598 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -5056,6 +5056,7 @@ individually controlled.  The warnings that are not turned on by this
 switch are
 @option{-gnatwd} (implicit dereferencing),
 @option{-gnatwh} (hiding),
+@option{-gnatw.h} (holes (gaps) in record layouts)
 @option{-gnatwl} (elaboration warnings),
 @option{-gnatw.o} (warn on values set by out parameters ignored)
 and @option{-gnatwt} (tracking of deleted conditional code).
@@ -5258,6 +5259,22 @@ Note that @option{-gnatwa} does not affect the setting of this warning option.
 @cindex @option{-gnatwH} (@command{gcc})
 This switch suppresses warnings on hiding declarations.
 
+@item -gnatw.h
+@emph{Activate warnings on holes/gaps in records.}
+@cindex @option{-gnatw.h} (@command{gcc})
+@cindex Record Representation (gaps)
+This switch activates warnings on component clauses in record
+representation clauses that leave holes (gaps) in the record layout.
+If this warning option is active, then record representation clauses
+should specify a contiguous layout, adding unused fill fields if needed.
+Note that @option{-gnatwa} does not affect the setting of this warning option.
+
+@item -gnatw.H
+@emph{Suppress warnings on holes/gaps in records.}
+@cindex @option{-gnatw.H} (@command{gcc})
+This switch suppresses warnings on component clauses in record
+representation clauses that leave holes (haps) in the record layout.
+
 @item -gnatwi
 @emph{Activate warnings on implementation units.}
 @cindex @option{-gnatwi} (@command{gcc})
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 45453e65..c24a344 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1535,9 +1535,11 @@ package body Sem_Ch13 is
             elsif Size /= No_Uint then
 
                if VM_Target /= No_VM and then not GNAT_Mode then
+
                   --  Size clause is not handled properly on VM targets.
                   --  Display a warning unless we are in GNAT mode, in which
                   --  case this is useless.
+
                   Error_Msg_N
                     ("?size clauses are ignored in this configuration", N);
                end if;
@@ -3255,6 +3257,9 @@ package body Sem_Ch13 is
       Overlap_Check_Required : Boolean;
       --  Used to keep track of whether or not an overlap check is required
 
+      Overlap_Detected : Boolean := False;
+      --  Set True if an overlap is detected
+
       Ccount : Natural := 0;
       --  Number of component clauses in record rep clause
 
@@ -3278,6 +3283,7 @@ package body Sem_Ch13 is
       procedure Check_Component_Overlap (C1_Ent, C2_Ent : Entity_Id) is
          CC1 : constant Node_Id := Component_Clause (C1_Ent);
          CC2 : constant Node_Id := Component_Clause (C2_Ent);
+
       begin
          if Present (CC1) and then Present (CC2) then
 
@@ -3309,6 +3315,7 @@ package body Sem_Ch13 is
                   Error_Msg_Node_1 := Component_Name (CC1);
                   Error_Msg_N
                     ("component& overlaps & #", Component_Name (CC1));
+                  Overlap_Detected := True;
                end if;
             end;
          end if;
@@ -3481,12 +3488,14 @@ package body Sem_Ch13 is
          if Present (Comp) then
             Ccount := Ccount + 1;
 
+            --  We need a full overlap check if record positions non-monotonic
+
             if Fbit <= Max_Bit_So_Far then
                Overlap_Check_Required := True;
-            else
-               Max_Bit_So_Far := Lbit;
             end if;
 
+            Max_Bit_So_Far := Lbit;
+
             --  Check bit position out of range of specified size
 
             if Has_Size_Clause (Rectype)
@@ -3505,6 +3514,7 @@ package body Sem_Ch13 is
                   Error_Msg_NE
                     ("component overlaps tag field of&",
                      Component_Name (CC), Rectype);
+                  Overlap_Detected := True;
                end if;
 
                if Hbit < Lbit then
@@ -3654,8 +3664,8 @@ package body Sem_Ch13 is
 
                --  Skip overlap check if entity has no declaration node. This
                --  happens with discriminants in constrained derived types.
-               --  Probably we are missing some checks as a result, but that
-               --  does not seem terribly serious ???
+               --  Possibly we are missing some checks as a result, but that
+               --  does not seem terribly serious.
 
                if No (Declaration_Node (C1_Ent)) then
                   goto Continue_Main_Component_Loop;
@@ -3699,7 +3709,6 @@ package body Sem_Ch13 is
 
                   else
                      Citem := First (Component_Items (Clist));
-
                      while Present (Citem) loop
                         if Nkind (Citem) = N_Component_Declaration then
                            C2_Ent := Defining_Identifier (Citem);
@@ -3745,6 +3754,183 @@ 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);
+                     Error_Msg_Uint_1 := Component_Bit_Offset (CEnt) - Nbit;
+
+                     if Error_Msg_Uint_1 > 0 then
+                        Error_Msg_NE
+                          ("?^-bit gap before component&",
+                           Component_Name (Component_Clause (CEnt)), CEnt);
+                     end if;
+
+                     Nbit := Component_Bit_Offset (CEnt) + Esize (CEnt);
+                  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
+
+         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;
+      end if;
+
       --  For records that have component clauses for all components, and whose
       --  size is less than or equal to 32, we need to know the size in the
       --  front end to activate possible packed array processing where the
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 95ee36f..6ffb7d8 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -5632,15 +5632,16 @@ package body Sem_Ch6 is
 
          begin
             --  In the case of functions with unconstrained result subtypes,
-            --  add a 3-state formal indicating whether the return object is
-            --  allocated by the caller (0), or should be allocated by the
-            --  callee on the secondary stack (1) or in the global heap (2).
-            --  For the moment we just use Natural for the type of this formal.
-            --  Note that this formal isn't usually needed in the case where
-            --  the result subtype is constrained, but it is needed when the
-            --  function has a tagged result, because generally such functions
-            --  can be called in a dispatching context and such calls must be
-            --  handled like calls to a class-wide function.
+            --  add a 4-state formal indicating whether the return object is
+            --  allocated by the caller (1), or should be allocated by the
+            --  callee on the secondary stack (2), in the global heap (3), or
+            --  in a user-defined storage pool (4). For the moment we just use
+            --  Natural for the type of this formal. Note that this formal
+            --  isn't usually needed in the case where the result subtype is
+            --  constrained, but it is needed when the function has a tagged
+            --  result, because generally such functions can be called in a
+            --  dispatching context and such calls must be handled like calls
+            --  to a class-wide function.
 
             if not Is_Constrained (Underlying_Type (Result_Subt))
               or else Is_Tagged_Type (Underlying_Type (Result_Subt))
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 953229c..2a42dec 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -3087,6 +3087,7 @@ package body Sem_Warn is
             Warn_On_Overlap                     := True;
             Warn_On_Parameter_Order             := True;
             Warn_On_Questionable_Missing_Parens := True;
+            Warn_On_Record_Holes                := True;
             Warn_On_Redundant_Constructs        := True;
             Warn_On_Reverse_Bit_Order           := True;
             Warn_On_Unchecked_Conversion        := True;
@@ -3098,6 +3099,12 @@ package body Sem_Warn is
          when 'g' =>
             Set_GNAT_Mode_Warnings;
 
+         when 'h' =>
+            Warn_On_Record_Holes                := True;
+
+         when 'H' =>
+            Warn_On_Record_Holes                := False;
+
          when 'i' =>
             Warn_On_Overlap                     := True;
 
@@ -3262,6 +3269,7 @@ package body Sem_Warn is
             Warn_On_Obsolescent_Feature         := False;
             Warn_On_Overlap                     := False;
             Warn_On_Parameter_Order             := False;
+            Warn_On_Record_Holes                := False;
             Warn_On_Questionable_Missing_Parens := False;
             Warn_On_Redundant_Constructs        := False;
             Warn_On_Reverse_Bit_Order           := False;
diff --git a/gcc/ada/sem_warn.ads b/gcc/ada/sem_warn.ads
index e74e144..259a470 100644
--- a/gcc/ada/sem_warn.ads
+++ b/gcc/ada/sem_warn.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1999-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1999-2010, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -33,6 +33,20 @@ with Types; use Types;
 
 package Sem_Warn is
 
+   -------------------
+   -- Warning Flags --
+   -------------------
+
+   --  These flags are activated or deactivated by -gnatw switches and control
+   --  whether warnings of a given class will be generated or not.
+
+   --  Note: most of these flags are still in opt, but the plan is to move them
+   --  here as time goes by.
+
+   Warn_On_Record_Holes : Boolean := False;
+   --  Warn when explicit record component clauses leave uncovered holes (gaps)
+   --  in a record layout. Off by default, set by -gnatw.h (but not -gnatwa).
+
    ------------------------
    -- Warnings Off Table --
    ------------------------
diff --git a/gcc/ada/ug_words b/gcc/ada/ug_words
index 5f694b9..6090e8f 100644
--- a/gcc/ada/ug_words
+++ b/gcc/ada/ug_words
@@ -138,6 +138,8 @@ gcc -c          ^ GNAT COMPILE
 -gnatwG         ^ /WARNINGS=NOUNRECOGNIZED_PRAGMAS
 -gnatwh         ^ /WARNINGS=HIDING
 -gnatwH         ^ /WARNINGS=NOHIDING
+-gnatw.h        ^ /WARNINGS=AVOIDGAPS
+-gnatw.H        ^ /WARNINGS=NOAVOIDGAPS
 -gnatwi         ^ /WARNINGS=IMPLEMENTATION
 -gnatwI         ^ /WARNINGS=NOIMPLEMENTATION
 -gnatwj         ^ /WARNINGS=OBSOLESCENT
diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb
index c0b7ce6..7df5eb0 100644
--- a/gcc/ada/usage.adb
+++ b/gcc/ada/usage.adb
@@ -422,6 +422,8 @@ begin
    Write_Line ("        G    turn off warnings for unrecognized pragma");
    Write_Line ("        h    turn on warnings for hiding variable");
    Write_Line ("        H*   turn off warnings for hiding variable");
+   Write_Line ("        .h   turn on warnings for holes in records");
+   Write_Line ("        .H*  turn off warnings for holes in records");
    Write_Line ("        i*+  turn on warnings for implementation unit");
    Write_Line ("        I    turn off warnings for implementation unit");
    Write_Line ("        .i   turn on warnings for overlapping actuals");
diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads
index aab456c..06ae3db 100644
--- a/gcc/ada/vms_data.ads
+++ b/gcc/ada/vms_data.ads
@@ -2951,6 +2951,10 @@ package VMS_Data is
                                                "-gnatwh "                  &
                                             "NOHIDING "                    &
                                                "-gnatwH "                  &
+                                            "AVOIDGAPS "                   &
+                                               "-gnatw.h "                 &
+                                            "NOAVOIDGAPS "                 &
+                                               "-gnatw.H "                 &
                                             "IMPLEMENTATION "              &
                                                "-gnatwi "                  &
                                             "NOIMPLEMENTATION "            &