2007-04-06 Robert Dewar <dewar@adacore.com>

	* sem_ch13.ads, sem_ch13.adb (Adjust_Record_For_Reverse_Bit_Order):
	Use First/Next_Component_Or_Discriminant
	(Analyze_Record_Representation_Clause):
	Use First/Next_Component_Or_Discriminant
	(Check_Component_Overlap): Use First/Next_Component_Or_Discriminant
	(Analyze_Attribute_Definition_Clause, case Value_Size): Reject
	definition if type is unconstrained.
	(Adjust_Record_For_Reverse_Bit_Order): New procedure
	(Analyze_Attribute_Definition_Clause): Split Is_Abstract flag into
	Is_Abstract_Subprogram and Is_Abstract_Type.
	(Adjust_Record_For_Reverse_Bit_Order): New procedure

	* repinfo.adb (List_Record_Info): Use First/
	Next_Component_Or_Discriminant.

	* style.ads, styleg-c.adb, styleg-c.ads (Check_Array_Attribute_Index):
	New procedure.

	* stylesw.ads, stylesw.adb: Recognize new -gnatyA style switch
	Include -gnatyA in default switches

	* opt.ads: (Warn_On_Non_Local_Exception): New flag
	(Warn_On_Reverse_Bit_Order): New flag
	(Extensions_Allowed): Update the documentation.
	(Warn_On_Questionable_Missing_Parens): Now on by default

	* usage.adb: Add documentation of -gnatw.x/X switches
	Document new -gnatyA style switch
	-gnatq warnings are on by default



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@123590 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 288 insertions, 38 deletions

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 6a49bd565ca..e6925f37866 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -166,6 +166,265 @@ package body Sem_Ch13 is
       return Empty;
    end Address_Aliased_Entity;
 
+   -----------------------------------------
+   -- Adjust_Record_For_Reverse_Bit_Order --
+   -----------------------------------------
+
+   procedure Adjust_Record_For_Reverse_Bit_Order (R : Entity_Id) is
+      Max_Machine_Scalar_Size : constant Uint :=
+                                  UI_From_Int
+                                    (Standard_Long_Long_Integer_Size);
+      --  We use this as the maximum machine scalar size in the sense of AI-133
+
+      Num_CC : Natural;
+      Comp   : Entity_Id;
+      SSU    : constant Uint := UI_From_Int (System_Storage_Unit);
+
+   begin
+      --  This first loop through components does two things. First it deals
+      --  with the case of components with component clauses whose length is
+      --  greater than the maximum machine scalar size (either accepting them
+      --  or rejecting as needed). Second, it counts the number of components
+      --  with component clauses whose length does not exceed this maximum for
+      --  later processing.
+
+      Num_CC := 0;
+      Comp   := First_Component_Or_Discriminant (R);
+      while Present (Comp) loop
+         declare
+            CC    : constant Node_Id := Component_Clause (Comp);
+            Fbit  : constant Uint    := Static_Integer (First_Bit (CC));
+
+         begin
+            if Present (CC) then
+
+               --  Case of component with size > max machine scalar
+
+               if Esize (Comp) > Max_Machine_Scalar_Size then
+
+                  --  Must begin on byte boundary
+
+                  if Fbit mod SSU /= 0 then
+                     Error_Msg_N
+                       ("illegal first bit value for reverse bit order",
+                        First_Bit (CC));
+                     Error_Msg_Uint_1 := SSU;
+                     Error_Msg_Uint_2 := Max_Machine_Scalar_Size;
+
+                     Error_Msg_N
+                       ("\must be a multiple of ^ if size greater than ^",
+                        First_Bit (CC));
+
+                  --  Must end on byte boundary
+
+                  elsif Esize (Comp) mod SSU /= 0 then
+                     Error_Msg_N
+                       ("illegal last bit value for reverse bit order",
+                        Last_Bit (CC));
+                     Error_Msg_Uint_1 := SSU;
+                     Error_Msg_Uint_2 := Max_Machine_Scalar_Size;
+
+                     Error_Msg_N
+                       ("\must be a multiple of ^ if size greater than ^",
+                        Last_Bit (CC));
+
+                  --  OK, give warning if enabled
+
+                  elsif Warn_On_Reverse_Bit_Order then
+                     Error_Msg_N
+                       ("multi-byte field specified with non-standard"
+                        & " Bit_Order?", CC);
+
+                     if Bytes_Big_Endian then
+                        Error_Msg_N
+                          ("\bytes are not reversed "
+                           & "(component is big-endian)?", CC);
+                     else
+                        Error_Msg_N
+                          ("\bytes are not reversed "
+                           & "(component is little-endian)?", CC);
+                     end if;
+                  end if;
+
+               --  Case where size is not greater than max machine scalar.
+               --  For now, we just count these.
+
+               else
+                  Num_CC := Num_CC + 1;
+               end if;
+            end if;
+         end;
+
+         Next_Component_Or_Discriminant (Comp);
+      end loop;
+
+      --  We need to sort the component clauses on the basis of the Position
+      --  values in the clause, so we can group clauses with the same Position
+      --  together to determine the relevant machine scalar size.
+
+      declare
+         Comps : array (0 .. Num_CC) of Entity_Id;
+         --  Array to collect component and discrimninant entities. The data
+         --  starts at index 1, the 0'th entry is for GNAT.Heap_Sort_A.
+
+         function CP_Lt (Op1, Op2 : Natural) return Boolean;
+         --  Compare routine for Sort (See GNAT.Heap_Sort_A)
+
+         procedure CP_Move (From : Natural; To : Natural);
+         --  Move routine for Sort (see GNAT.Heap_Sort_A)
+
+         Start : Natural;
+         Stop  : Natural;
+         --  Start and stop positions in component list of set of components
+         --  with the same starting position (that constitute components in
+         --  a single machine scalar).
+
+         MaxL : Uint;
+         --  Maximum last bit value of any component in this set
+
+         MSS : Uint;
+         --  Corresponding machine scalar size
+
+         -----------
+         -- CP_Lt --
+         -----------
+
+         function CP_Lt (Op1, Op2 : Natural) return Boolean is
+         begin
+            return Position (Component_Clause (Comps (Op1))) <
+                   Position (Component_Clause (Comps (Op2)));
+         end CP_Lt;
+
+         -------------
+         -- CP_Move --
+         -------------
+
+         procedure CP_Move (From : Natural; To : Natural) is
+         begin
+            Comps (To) := Comps (From);
+         end CP_Move;
+
+      begin
+         --  Collect the component clauses
+
+         Num_CC := 0;
+         Comp   := First_Component_Or_Discriminant (R);
+         while Present (Comp) loop
+            if Present (Component_Clause (Comp))
+              and then Esize (Comp) <= Max_Machine_Scalar_Size
+            then
+               Num_CC := Num_CC + 1;
+               Comps (Num_CC) := Comp;
+            end if;
+
+            Next_Component_Or_Discriminant (Comp);
+         end loop;
+
+         --  Sort by ascending position number
+
+         Sort (Num_CC, CP_Move'Unrestricted_Access, CP_Lt'Unrestricted_Access);
+
+         --  We now have all the components whose size does not exceed the max
+         --  machine scalar value, sorted by starting position. In this loop
+         --  we gather groups of clauses starting at the same position, to
+         --  process them in accordance with Ada 2005 AI-133.
+
+         Stop := 0;
+         while Stop < Num_CC loop
+            Start := Stop + 1;
+            Stop  := Start;
+            MaxL  :=
+              Static_Integer (Last_Bit (Component_Clause (Comps (Start))));
+            while Stop < Num_CC loop
+               if Static_Integer
+                    (Position (Component_Clause (Comps (Stop + 1)))) =
+                  Static_Integer
+                    (Position (Component_Clause (Comps (Stop))))
+               then
+                  Stop := Stop + 1;
+                  MaxL :=
+                    UI_Max
+                      (MaxL,
+                       Static_Integer
+                         (Last_Bit (Component_Clause (Comps (Stop)))));
+               else
+                  exit;
+               end if;
+            end loop;
+
+            --  Now we have a group of component clauses from Start to Stop
+            --  whose positions are identical, and MaxL is the maximum last bit
+            --  value of any of these components.
+
+            --  We need to determine the corresponding machine scalar size.
+            --  This loop assumes that machine scalar sizes are even, and that
+            --  each possible machine scalar has twice as many bits as the
+            --  next smaller one.
+
+            MSS := Max_Machine_Scalar_Size;
+            while MSS mod 2 = 0
+              and then (MSS / 2) >= SSU
+              and then (MSS / 2) > MaxL
+            loop
+               MSS := MSS / 2;
+            end loop;
+
+            --  Here is where we fix up the Component_Bit_Offset value to
+            --  account for the reverse bit order. Some examples of what needs
+            --  to be done for the case of a machine scalar size of 8 are:
+
+            --    First_Bit .. Last_Bit     Component_Bit_Offset
+            --      old          new          old       new
+
+            --     0 .. 0       7 .. 7         0         7
+            --     0 .. 1       6 .. 7         0         6
+            --     0 .. 2       5 .. 7         0         5
+            --     0 .. 7       0 .. 7         0         4
+
+            --     1 .. 1       6 .. 6         1         6
+            --     1 .. 4       3 .. 6         1         3
+            --     4 .. 7       0 .. 3         4         0
+
+            --  The general rule is that the first bit is is obtained by
+            --  subtracting the old ending bit from machine scalar size - 1.
+
+            for C in Start .. Stop loop
+               declare
+                  Comp : constant Entity_Id := Comps (C);
+                  CC   : constant Node_Id   := Component_Clause (Comp);
+                  LB   : constant Uint := Static_Integer (Last_Bit (CC));
+                  NFB  : constant Uint := MSS - Uint_1 - LB;
+                  NLB  : constant Uint := NFB + Esize (Comp) - 1;
+                  Pos  : constant Uint := Static_Integer (Position (CC));
+
+               begin
+                  if Warn_On_Reverse_Bit_Order then
+                     Error_Msg_Uint_1 := MSS;
+                     Error_Msg_N
+                       ("?reverse bit order in machine " &
+                       "scalar of length^", First_Bit (CC));
+                     Error_Msg_Uint_1 := NFB;
+                     Error_Msg_Uint_2 := NLB;
+
+                     if Bytes_Big_Endian then
+                        Error_Msg_NE
+                          ("?\big-endian range for component & is ^ .. ^",
+                           First_Bit (CC), Comp);
+                     else
+                        Error_Msg_NE
+                          ("?\little-endian range for component & is ^ .. ^",
+                           First_Bit (CC), Comp);
+                     end if;
+                  end if;
+
+                  Set_Component_Bit_Offset (Comp, Pos * SSU + NFB);
+                  Set_Normalized_First_Bit (Comp, NFB mod SSU);
+               end;
+            end loop;
+         end loop;
+      end;
+   end Adjust_Record_For_Reverse_Bit_Order;
+
    --------------------------------------
    -- Alignment_Check_For_Esize_Change --
    --------------------------------------
@@ -355,7 +614,7 @@ package body Sem_Ch13 is
          end if;
 
          if Present (Subp) then
-            if Is_Abstract (Subp) then
+            if Is_Abstract_Subprogram (Subp) then
                Error_Msg_N ("stream subprogram must not be abstract", Expr);
                return;
             end if;
@@ -926,12 +1185,12 @@ package body Sem_Ch13 is
                   Etyp := Etype (U_Ent);
                end if;
 
-               --  Check size, note that Gigi is in charge of checking
-               --  that the size of an array or record type is OK. Also
-               --  we do not check the size in the ordinary fixed-point
-               --  case, since it is too early to do so (there may be a
-               --  subsequent small clause that affects the size). We can
-               --  check the size if a small clause has already been given.
+               --  Check size, note that Gigi is in charge of checking that the
+               --  size of an array or record type is OK. Also we do not check
+               --  the size in the ordinary fixed-point case, since it is too
+               --  early to do so (there may be subsequent small clause that
+               --  affects the size). We can check the size if a small clause
+               --  has already been given.
 
                if not Is_Ordinary_Fixed_Point_Type (U_Ent)
                  or else Has_Small_Clause (U_Ent)
@@ -945,9 +1204,9 @@ package body Sem_Ch13 is
                if Is_Type (U_Ent) then
                   Set_RM_Size (U_Ent, Size);
 
-                  --  For scalar types, increase Object_Size to power of 2,
-                  --  but not less than a storage unit in any case (i.e.,
-                  --  normally this means it will be byte addressable).
+                  --  For scalar types, increase Object_Size to power of 2, but
+                  --  not less than a storage unit in any case (i.e., normally
+                  --  this means it will be byte addressable).
 
                   if Is_Scalar_Type (U_Ent) then
                      if Size <= System_Storage_Unit then
@@ -1294,6 +1553,12 @@ package body Sem_Ch13 is
             then
                Error_Msg_N ("Value_Size already given for &", Nam);
 
+            elsif Is_Array_Type (U_Ent)
+              and then not Is_Constrained (U_Ent)
+            then
+               Error_Msg_N
+                 ("Value_Size cannot be given for unconstrained array", Nam);
+
             else
                if Is_Elementary_Type (U_Ent) then
                   Check_Size (Expr, U_Ent, Size, Biased);
@@ -1837,17 +2102,10 @@ package body Sem_Ch13 is
       --  Clear any existing component clauses for the type (this happens
       --  with derived types, where we are now overriding the original)
 
-      Fent := First_Entity (Rectype);
-
-      Comp := Fent;
+      Comp := First_Component_Or_Discriminant (Rectype);
       while Present (Comp) loop
-         if Ekind (Comp) = E_Component
-           or else Ekind (Comp) = E_Discriminant
-         then
-            Set_Component_Clause (Comp, Empty);
-         end if;
-
-         Next_Entity (Comp);
+         Set_Component_Clause (Comp, Empty);
+         Next_Component_Or_Discriminant (Comp);
       end loop;
 
       --  All done if no component clauses
@@ -1862,6 +2120,8 @@ package body Sem_Ch13 is
       --  it at the start of the record (otherwise gigi may place it after
       --  other fields that have rep clauses).
 
+      Fent := First_Entity (Rectype);
+
       if Nkind (Fent) = N_Defining_Identifier
         and then Chars (Fent) = Name_uTag
       then
@@ -2284,15 +2544,10 @@ package body Sem_Ch13 is
       then
          --  Nothing to do if at least one component with no component clause
 
-         Comp := First_Entity (Rectype);
+         Comp := First_Component_Or_Discriminant (Rectype);
          while Present (Comp) loop
-            if Ekind (Comp) = E_Component
-              or else Ekind (Comp) = E_Discriminant
-            then
-               exit when No (Component_Clause (Comp));
-            end if;
-
-            Next_Entity (Comp);
+            exit when No (Component_Clause (Comp));
+            Next_Component_Or_Discriminant (Comp);
          end loop;
 
          --  If we fall out of loop, all components have component clauses
@@ -2306,19 +2561,14 @@ package body Sem_Ch13 is
       --  Check missing components if Complete_Representation pragma appeared
 
       if Present (CR_Pragma) then
-         Comp := First_Entity (Rectype);
+         Comp := First_Component_Or_Discriminant (Rectype);
          while Present (Comp) loop
-            if Ekind (Comp) = E_Component
-                 or else
-               Ekind (Comp) = E_Discriminant
-            then
-               if No (Component_Clause (Comp)) then
-                  Error_Msg_NE
-                    ("missing component clause for &", CR_Pragma, Comp);
-               end if;
+            if No (Component_Clause (Comp)) then
+               Error_Msg_NE
+                 ("missing component clause for &", CR_Pragma, Comp);
             end if;
 
-            Next_Entity (Comp);
+            Next_Component_Or_Discriminant (Comp);
          end loop;
       end if;
    end Analyze_Record_Representation_Clause;