diff mbox

[Ada] Implement style switch -gnatyE for enumeration ranges

Message ID 20100909094444.GA30813@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Sept. 9, 2010, 9:44 a.m. UTC
This patch adds a new style switch that prohibits explicit
enumeration ranges in other than the unit declaring the type
(or its body or subunits). Eventually this will be added to
GNAT_Mode to include it in -gnatg and -gnatyg, but this is
not done yet (pending checking all affected tools). The
following is compiled with -gnatyE

     1. with EnumSRPkg; use EnumSRPkg;
     2. procedure Enumsr is
     3.    subtype RBG_Local is
     4.      RBGE range red .. blue;     -- FLAG
                            |
        >>> (style) explicit enumeration subrange not allowed

     5.    V : RBGE := blue;
     6.
     7.    type VAR is
     8.      array (RBGE range <>)
     9.        of Boolean;
    10.
    11.    VR : VAR (RBGE) :=
    12.           (others => True);
    13.
    14.    VR2 : Var (red .. blue) :=    -- FLAG
                          |
        >>> (style) explicit enumeration subrange not allowed

    15.            (others => False);
    16.
    17. begin
    18.    for J in RBG loop
    19.       null;
    20.    end loop;
    21.
    22.    for J in red .. blue loop     -- FLAG
                        |
        >>> (style) explicit enumeration subrange not allowed

    23.       null;
    24.    end loop;
    25.
    26.    if V in red .. green then     -- FLAG
                       |
        >>> (style) explicit enumeration subrange not allowed

    27.       null;
    28.    end if;
    29.
    30.    case V is
    31.       when red =>
    32.          null;
    33.       when green .. yellow =>    -- FLAG
                         |
        >>> (style) explicit enumeration subrange not allowed

    34.          null;
    35.    end case;
    36.
    37.    VR (green ..  yellow) :=      -- FLAG
                     |
        >>> (style) explicit enumeration subrange not allowed

    38.      (others => False);
    39.
    40.    VR2 := (others => True);
    41.
    42. end Enumsr;

where the package EnumSRPkg is:

package EnumSRPkg is
   type RBGE is (red, green, blue, yellow);
   subtype RBG is RBGE range red .. blue;
end;

Tested on x86_64-pc-linux-gnu, committed on trunk

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

	* bindgen.adb (Gen_Restrictions_Ada): Avoid explicit enumeration ranges
	(Gen_Restrictions_C): Avoid explicit enumeration ranges
	(Set_String_Replace): New procedure
	* casing.ads (Known_Casing): New subtype declaration
	* prj-attr.ads (All_Case_Insensitive_Associative_Array): New subtype
	declaration
	* prj-dect.adb (Parse_Attribute_Declaration): Avoid enumeration range
	* prj-nmsc.adb (Check_Naming): Avoid unnecessary enumeration range
	* prj-strt.adb (Attribute_Reference): Avoid enumeration range test
	* prj.adb (Known_Casing): Moved to Casing spec (avoid enum range)
	* sem_ch13.adb (Adjust_Record_For_Reverse_Bit_Order): Avoid enumeration
	ranges
	* sem_res.adb (Resolve_Range): Check for enumeration subrange style rule
	* sem_type.adb (Is_Array_Class_Record_Type): New.
	* style.ads (Check_Enumeration_Subrange): New procedure
	* styleg.adb (Check_Enumeration_Subrange): New procedure
	* styleg.ads (Check_Enumeration_Subrange): New procedure
	* stylesw.adb Add handling for Style_Check_Enumeration_Subranges
	* stylesw.ads (Style_Check_Enumeration_Subranges): New flag
	* usage.adb: Add line for -gnatyE
	* vms_data.ads: Add entries for [NO]ENUMERATION_RANGES
	Add missing entry for NOBOOLEAN_OPERATORS
diff mbox

Patch

Index: sem_type.adb
===================================================================
--- sem_type.adb	(revision 164056)
+++ sem_type.adb	(working copy)
@@ -184,6 +184,18 @@  package body Sem_Type is
    --  Interp_Has_Abstract_Op. Determine whether an overloaded node has an
    --  abstract interpretation which yields type Typ.
 
+   function Is_Array_Class_Record_Type (E : Entity_Id) return Boolean;
+   --  This function tests if entity E is in Array_Kind, or Class_Wide_Kind,
+   --  or is E_Record_Type or E_Record_Subtype, and returns True for these
+   --  cases, and False for all others. Note that other record entity kinds
+   --  such as E_Record_Type_With_Private return False.
+   --
+   --  This is a bit of an odd category, maybe it is wrong or a better name
+   --  could be found for the class of entities being tested. The history
+   --  is that this used to be done with an explicit range test for the range
+   --  E_Array_Type .. E_Record_Subtype, which was itself suspicious and is
+   --  now prohibited by the -gnatyE style check ???
+
    procedure New_Interps (N : Node_Id);
    --  Initialize collection of interpretations for the given node, which is
    --  either an overloaded entity, or an operation whose arguments have
@@ -900,7 +912,7 @@  package body Sem_Type is
       --  An aggregate is compatible with an array or record type
 
       elsif T2 = Any_Composite
-        and then Ekind (T1) in E_Array_Type .. E_Record_Subtype
+        and then Is_Array_Class_Record_Type (T1)
       then
          return True;
 
@@ -2615,6 +2627,18 @@  package body Sem_Type is
       end if;
    end Is_Ancestor;
 
+   --------------------------------
+   -- Is_Array_Class_Record_Type --
+   --------------------------------
+
+   function Is_Array_Class_Record_Type (E : Entity_Id) return Boolean is
+   begin
+      return Is_Array_Type (E)
+        or else Is_Class_Wide_Type (E)
+        or else Ekind (E) = E_Record_Type
+        or else Ekind (E) = E_Record_Subtype;
+   end Is_Array_Class_Record_Type;
+
    ---------------------------
    -- Is_Invisible_Operator --
    ---------------------------
@@ -3033,12 +3057,12 @@  package body Sem_Type is
          return T1;
 
       elsif T2 = Any_Composite
-        and then Ekind (T1) in E_Array_Type .. E_Record_Subtype
+        and then Is_Array_Class_Record_Type (T1)
       then
          return T1;
 
       elsif T1 = Any_Composite
-        and then Ekind (T2) in E_Array_Type .. E_Record_Subtype
+        and then Is_Array_Class_Record_Type (T2)
       then
          return T2;
 
Index: casing.ads
===================================================================
--- casing.ads	(revision 164000)
+++ casing.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---         Copyright (C) 1992-2009  Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-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- --
@@ -61,6 +61,9 @@  package Casing is
       --  (e.g. X, Y_3, M4, A_B, or if it is inconsistent ABC_def).
    );
 
+   subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
+   --  Exclude Unknown casing
+
    ------------------------------
    -- Case Control Subprograms --
    ------------------------------
Index: usage.adb
===================================================================
--- usage.adb	(revision 164000)
+++ usage.adb	(working copy)
@@ -533,6 +533,7 @@  begin
    Write_Line ("        c    check comment format");
    Write_Line ("        d    check no DOS line terminators");
    Write_Line ("        e    check end/exit labels present");
+   Write_Line ("        E    check no explicit enumeration subranges");
    Write_Line ("        f    check no form feeds/vertical tabs in source");
    Write_Line ("        g    check standard GNAT style rules");
    Write_Line ("        h    check no horizontal tabs in source");
Index: style.ads
===================================================================
--- style.ads	(revision 164000)
+++ style.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-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- --
@@ -103,6 +103,9 @@  package Style is
    --  Called after scanning out a binary operator other than a plus, minus
    --  or exponentiation operator. Intended for checking spacing rules.
 
+   procedure Check_Enumeration_Subrange (N : Node_Id)
+     renames Style_Inst.Check_Enumeration_Subrange;
+
    procedure Check_Exponentiation_Operator
      renames Style_Inst.Check_Exponentiation_Operator;
    --  Called after scanning out an exponentiation operator. Intended for
Index: bindgen.adb
===================================================================
--- bindgen.adb	(revision 164000)
+++ bindgen.adb	(working copy)
@@ -349,6 +349,11 @@  package body Bindgen is
    --  Sets characters of given string in Statement_Buffer, starting at the
    --  Last + 1 position, and updating last past the string value.
 
+   procedure Set_String_Replace (S : String);
+   --  Replaces the last S'Length characters in the Statement_Buffer with
+   --  the characters of S. The caller must ensure that these characters do
+   --  in fact exist in the Statement_Buffer.
+
    procedure Set_Unit_Name;
    --  Given a unit name in the Name_Buffer, copies it to Statement_Buffer,
    --  starting at the Last + 1 position, and updating last past the value.
@@ -2801,9 +2806,7 @@  package body Bindgen is
 
       Count := 0;
 
-      for J in Cumulative_Restrictions.Set'First ..
-        Restriction_Id'Pred (Cumulative_Restrictions.Set'Last)
-      loop
+      for J in Cumulative_Restrictions.Set'Range loop
          Set_Boolean (Cumulative_Restrictions.Set (J));
          Set_String (", ");
          Count := Count + 1;
@@ -2815,30 +2818,22 @@  package body Bindgen is
          end if;
       end loop;
 
-      Set_Boolean
-        (Cumulative_Restrictions.Set (Cumulative_Restrictions.Set'Last));
-      Set_String ("),");
+      Set_String_Replace ("),");
       Write_Statement_Buffer;
       Set_String ("         Value => (");
 
-      for J in Cumulative_Restrictions.Value'First ..
-        Restriction_Id'Pred (Cumulative_Restrictions.Value'Last)
-      loop
+      for J in Cumulative_Restrictions.Value'Range loop
          Set_Int (Int (Cumulative_Restrictions.Value (J)));
          Set_String (", ");
       end loop;
 
-      Set_Int (Int (Cumulative_Restrictions.Value
-        (Cumulative_Restrictions.Value'Last)));
-      Set_String ("),");
+      Set_String_Replace ("),");
       Write_Statement_Buffer;
       WBI ("         Violated =>");
       Set_String ("          (");
       Count := 0;
 
-      for J in Cumulative_Restrictions.Violated'First ..
-        Restriction_Id'Pred (Cumulative_Restrictions.Violated'Last)
-      loop
+      for J in Cumulative_Restrictions.Violated'Range loop
          Set_Boolean (Cumulative_Restrictions.Violated (J));
          Set_String (", ");
          Count := Count + 1;
@@ -2850,36 +2845,26 @@  package body Bindgen is
          end if;
       end loop;
 
-      Set_Boolean (Cumulative_Restrictions.Violated
-        (Cumulative_Restrictions.Violated'Last));
-      Set_String ("),");
+      Set_String_Replace ("),");
       Write_Statement_Buffer;
       Set_String ("         Count => (");
 
-      for J in Cumulative_Restrictions.Count'First ..
-        Restriction_Id'Pred (Cumulative_Restrictions.Count'Last)
-      loop
+      for J in Cumulative_Restrictions.Count'Range loop
          Set_Int (Int (Cumulative_Restrictions.Count (J)));
          Set_String (", ");
       end loop;
 
-      Set_Int (Int (Cumulative_Restrictions.Count
-        (Cumulative_Restrictions.Count'Last)));
-      Set_String ("),");
+      Set_String_Replace ("),");
       Write_Statement_Buffer;
       Set_String ("         Unknown => (");
 
-      for J in Cumulative_Restrictions.Unknown'First ..
-        Restriction_Id'Pred (Cumulative_Restrictions.Unknown'Last)
-      loop
+      for J in Cumulative_Restrictions.Unknown'Range loop
          Set_Boolean (Cumulative_Restrictions.Unknown (J));
          Set_String (", ");
       end loop;
 
-      Set_Boolean
-        (Cumulative_Restrictions.Unknown
-          (Cumulative_Restrictions.Unknown'Last));
-      Set_String ("));");
+      Set_String_Replace ("))");
+      Set_String (";");
       Write_Statement_Buffer;
    end Gen_Restrictions_Ada;
 
@@ -2926,68 +2911,49 @@  package body Bindgen is
       WBI ("   restrictions r = {");
       Set_String ("     {");
 
-      for J in Cumulative_Restrictions.Set'First ..
-        Restriction_Id'Pred (Cumulative_Restrictions.Set'Last)
-      loop
+      for J in Cumulative_Restrictions.Set'Range loop
          Set_Int (Boolean'Pos (Cumulative_Restrictions.Set (J)));
          Set_String (", ");
       end loop;
 
-      Set_Int (Boolean'Pos
-        (Cumulative_Restrictions.Set (Cumulative_Restrictions.Set'Last)));
-      Set_String ("},");
+      Set_String_Replace ("},");
       Write_Statement_Buffer;
       Set_String ("     {");
 
-      for J in Cumulative_Restrictions.Value'First ..
-        Restriction_Id'Pred (Cumulative_Restrictions.Value'Last)
-      loop
+      for J in Cumulative_Restrictions.Value'Range loop
          Set_Int (Int (Cumulative_Restrictions.Value (J)));
          Set_String (", ");
       end loop;
 
-      Set_Int (Int (Cumulative_Restrictions.Value
-        (Cumulative_Restrictions.Value'Last)));
-      Set_String ("},");
+      Set_String_Replace ("},");
       Write_Statement_Buffer;
       Set_String ("     {");
 
-      for J in Cumulative_Restrictions.Violated'First ..
-        Restriction_Id'Pred (Cumulative_Restrictions.Violated'Last)
-      loop
+      for J in Cumulative_Restrictions.Violated'Range loop
          Set_Int (Boolean'Pos (Cumulative_Restrictions.Violated (J)));
          Set_String (", ");
       end loop;
 
-      Set_Int (Boolean'Pos (Cumulative_Restrictions.Violated
-        (Cumulative_Restrictions.Violated'Last)));
-      Set_String ("},");
+      Set_String_Replace ("},");
       Write_Statement_Buffer;
       Set_String ("     {");
 
-      for J in Cumulative_Restrictions.Count'First ..
-        Restriction_Id'Pred (Cumulative_Restrictions.Count'Last)
-      loop
+      for J in Cumulative_Restrictions.Count'Range loop
          Set_Int (Int (Cumulative_Restrictions.Count (J)));
          Set_String (", ");
       end loop;
 
-      Set_Int (Int (Cumulative_Restrictions.Count
-        (Cumulative_Restrictions.Count'Last)));
-      Set_String ("},");
+      Set_String_Replace ("},");
       Write_Statement_Buffer;
       Set_String ("     {");
 
-      for J in Cumulative_Restrictions.Unknown'First ..
-        Restriction_Id'Pred (Cumulative_Restrictions.Unknown'Last)
-      loop
+      for J in Cumulative_Restrictions.Unknown'Range loop
          Set_Int (Boolean'Pos (Cumulative_Restrictions.Unknown (J)));
          Set_String (", ");
       end loop;
 
-      Set_Int (Boolean'Pos (Cumulative_Restrictions.Unknown
-          (Cumulative_Restrictions.Unknown'Last)));
-      Set_String ("}};");
+      Set_String_Replace ("}}");
+      Set_String (";");
       Write_Statement_Buffer;
       WBI ("   system__restrictions__run_time_restrictions = r;");
    end Gen_Restrictions_C;
@@ -3475,6 +3441,15 @@  package body Bindgen is
       Last := Last + S'Length;
    end Set_String;
 
+   ------------------------
+   -- Set_String_Replace --
+   ------------------------
+
+   procedure Set_String_Replace (S : String) is
+   begin
+      Statement_Buffer (Last - S'Length + 1 .. Last) := S;
+   end Set_String_Replace;
+
    -------------------
    -- Set_Unit_Name --
    -------------------
Index: prj-strt.adb
===================================================================
--- prj-strt.adb	(revision 164000)
+++ prj-strt.adb	(working copy)
@@ -216,8 +216,7 @@  package body Prj.Strt is
             Set_Case_Insensitive
               (Reference, In_Tree,
                To => Attribute_Kind_Of (Current_Attribute) in
-                      Case_Insensitive_Associative_Array ..
-                        Optional_Index_Case_Insensitive_Associative_Array);
+                      All_Case_Insensitive_Associative_Array);
 
             --  Scan past the attribute name
 
Index: prj.adb
===================================================================
--- prj.adb	(revision 164000)
+++ prj.adb	(working copy)
@@ -48,8 +48,6 @@  package body Prj is
 
    The_Empty_String : Name_Id := No_Name;
 
-   subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
-
    type Cst_String_Access is access constant String;
 
    All_Lower_Case_Image : aliased constant String := "lowercase";
Index: sem_res.adb
===================================================================
--- sem_res.adb	(revision 164000)
+++ sem_res.adb	(working copy)
@@ -7611,6 +7611,10 @@  package body Sem_Res is
       Resolve (L, Typ);
       Resolve (H, Typ);
 
+      if Style_Check then
+         Check_Enumeration_Subrange (N);
+      end if;
+
       Check_Unset_Reference (L);
       Check_Unset_Reference (H);
 
Index: stylesw.adb
===================================================================
--- stylesw.adb	(revision 164000)
+++ stylesw.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-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- --
@@ -59,6 +59,12 @@  package body Stylesw is
                      "u" &  -- check no unnecessary blank lines
                      "x";   -- check extra parentheses around conditionals
 
+   --  Note: we intend GNAT_Style to also include the following, but we do
+   --  not yet have the whole tool suite clean with respect to this.
+
+   --                "B" &  -- check boolean operators
+   --                "E" &  -- check enumeration ranges
+
    -------------------------------
    -- Reset_Style_Check_Options --
    -------------------------------
@@ -73,6 +79,7 @@  package body Stylesw is
       Style_Check_Boolean_And_Or        := False;
       Style_Check_Comments              := False;
       Style_Check_DOS_Line_Terminator   := False;
+      Style_Check_Enumeration_Subranges := False;
       Style_Check_End_Labels            := False;
       Style_Check_Form_Feeds            := False;
       Style_Check_Horizontal_Tabs       := False;
@@ -158,6 +165,7 @@  package body Stylesw is
       Add ('c', Style_Check_Comments);
       Add ('d', Style_Check_DOS_Line_Terminator);
       Add ('e', Style_Check_End_Labels);
+      Add ('E', Style_Check_Enumeration_Subranges);
       Add ('f', Style_Check_Form_Feeds);
       Add ('h', Style_Check_Horizontal_Tabs);
       Add ('i', Style_Check_If_Then_Layout);
@@ -324,6 +332,9 @@  package body Stylesw is
             when 'e' =>
                Style_Check_End_Labels            := True;
 
+            when 'E' =>
+               Style_Check_Enumeration_Subranges := True;
+
             when 'f' =>
                Style_Check_Form_Feeds            := True;
 
@@ -488,6 +499,9 @@  package body Stylesw is
             when 'e' =>
                Style_Check_End_Labels            := False;
 
+            when 'E' =>
+               Style_Check_Enumeration_Subranges := False;
+
             when 'f' =>
                Style_Check_Form_Feeds            := False;
 
Index: stylesw.ads
===================================================================
--- stylesw.ads	(revision 164000)
+++ stylesw.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-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- --
@@ -113,6 +113,12 @@  package Stylesw is
    --  This can be set True by using the -gnatye switch. If it is True, then
    --  optional END labels must always be present.
 
+   Style_Check_Enumeration_Subranges : Boolean := False;
+   --  This can be set True by using the -gnatyE switch. If it is True, then
+   --  explicit subranges (using .. notation) on enumeration subtypes are not
+   --  permitted in other than the same source unit in which the enumeration
+   --  subtype is declared.
+
    Style_Check_Form_Feeds : Boolean := False;
    --  This can be set True by using the -gnatyf switch. If it is True, then
    --  form feeds and vertical tabs are not allowed in the source text.
Index: prj-dect.adb
===================================================================
--- prj-dect.adb	(revision 164000)
+++ prj-dect.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-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- --
@@ -247,8 +247,7 @@  package body Prj.Dect is
             end if;
 
             if Attribute_Kind_Of (Current_Attribute) in
-                 Case_Insensitive_Associative_Array ..
-                 Optional_Index_Case_Insensitive_Associative_Array
+                 All_Case_Insensitive_Associative_Array
             then
                Set_Case_Insensitive (Attribute, In_Tree, To => True);
             end if;
Index: prj-nmsc.adb
===================================================================
--- prj-nmsc.adb	(revision 164000)
+++ prj-nmsc.adb	(working copy)
@@ -3310,7 +3310,7 @@  package body Prj.Nmsc is
 
          --  Get the naming exceptions for all languages
 
-         for Kind in Spec .. Impl loop
+         for Kind in Spec_Or_Body loop
             Lang_Id := Project.Languages;
             while Lang_Id /= No_Language_Index loop
                case Lang_Id.Config.Kind is
Index: vms_data.ads
===================================================================
--- vms_data.ads	(revision 164000)
+++ vms_data.ads	(working copy)
@@ -2259,10 +2259,12 @@  package VMS_Data is
                                                "-gnaty-A "                 &
                                             "BLANKS "                      &
                                                "-gnatyb "                  &
-                                            "BOOLEAN_OPERATORS "           &
-                                               "-gnatyB "                  &
                                             "NOBLANKS "                    &
                                                "-gnaty-b "                 &
+                                            "BOOLEAN_OPERATORS "           &
+                                               "-gnatyB "                  &
+                                            "NOBOOLEAN_OPERATORS "         &
+                                               "-gnaty-B "                 &
                                             "COMMENTS "                    &
                                                "-gnatyc "                  &
                                             "NOCOMMENTS "                  &
@@ -2275,6 +2277,10 @@  package VMS_Data is
                                                "-gnatye "                  &
                                             "NOEND "                       &
                                                "-gnaty-e "                 &
+                                            "ENUMERATION_RANGES "          &
+                                               "-gnatyE "                  &
+                                            "NOENUMERATION_RANGES "        &
+                                               "-gnaty-E "                 &
                                             "VTABS "                       &
                                                "-gnatyf "                  &
                                             "NOVTABS "                     &
Index: prj-attr.ads
===================================================================
--- prj-attr.ads	(revision 164000)
+++ prj-attr.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2001-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-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- --
@@ -44,8 +44,8 @@  package Prj.Attr is
    --  packages and their attribute. This procedure should be called by
    --  Prj.Initialize.
 
-   type Attribute_Kind is
-     (Unknown,
+   type Attribute_Kind is (
+      Unknown,
       --  The attribute does not exist
 
       Single,
@@ -61,9 +61,10 @@  package Prj.Attr is
       Case_Insensitive_Associative_Array,
       --  Associative array attribute with a case insensitive index
 
-      Optional_Index_Case_Insensitive_Associative_Array);
+      Optional_Index_Case_Insensitive_Associative_Array
       --  Associative array attribute with a case insensitive index and an
       --  optional source index.
+   );
    --  Characteristics of an attribute. Optional_Index indicates that there
    --  may be an optional index in the index of the associative array, as in
    --     for Switches ("files.ada" at 2) use ...
@@ -73,6 +74,11 @@  package Prj.Attr is
    --  Subset of Attribute_Kinds that may be used for the attributes that is
    --  used when defining a new package.
 
+   subtype All_Case_Insensitive_Associative_Array is Attribute_Kind range
+     Case_Insensitive_Associative_Array ..
+     Optional_Index_Case_Insensitive_Associative_Array;
+   --  Subtype including both cases of Case_Insensitive_Associative_Array
+
    Max_Attribute_Name_Length : constant := 64;
    --  The maximum length of attribute names
 
Index: styleg.adb
===================================================================
--- styleg.adb	(revision 164000)
+++ styleg.adb	(working copy)
@@ -32,10 +32,13 @@  with Casing;   use Casing;
 with Csets;    use Csets;
 with Einfo;    use Einfo;
 with Err_Vars; use Err_Vars;
+with Lib;      use Lib;
+with Namet;    use Namet;
 with Opt;      use Opt;
 with Scans;    use Scans;
 with Sinfo;    use Sinfo;
 with Sinput;   use Sinput;
+with Snames;   use Snames;
 with Stylesw;  use Stylesw;
 
 package body Styleg is
@@ -550,6 +553,82 @@  package body Styleg is
       end if;
    end Check_Dot_Dot;
 
+   --------------------------------
+   -- Check_Enumeration_Subrange --
+   --------------------------------
+
+   procedure Check_Enumeration_Subrange (N : Node_Id) is
+      function First_Last_Ref return Boolean;
+      --  Returns True if N is of the form X'First .. X'Last where X is the
+      --  same entity for both attributes. N is already known to be N_Range.
+
+      --------------------
+      -- First_Last_Ref --
+      --------------------
+
+      function First_Last_Ref return Boolean is
+         L : constant Node_Id := Low_Bound  (N);
+         H : constant Node_Id := High_Bound (N);
+
+      begin
+         if Nkind (L) = N_Attribute_Reference
+           and then Nkind (H) = N_Attribute_Reference
+           and then Attribute_Name (L) = Name_First
+           and then Attribute_Name (H) = Name_Last
+         then
+            declare
+               PL : constant Node_Id := Prefix (L);
+               PH : constant Node_Id := Prefix (H);
+            begin
+               if Is_Entity_Name (PL)
+                 and then Is_Entity_Name (PH)
+                 and then Entity (PL) = Entity (PH)
+               then
+                  return True;
+               end if;
+            end;
+         end if;
+
+         return False;
+      end First_Last_Ref;
+
+   --  Start of processing for Check_Enumeration_Subrange
+
+   begin
+      if Style_Check_Enumeration_Subranges then
+
+         if Nkind (N) = N_Range
+
+           --  Only consider ranges that are explicit in the source
+
+           and then Comes_From_Source (N)
+
+           --  Only consider enumeration types
+
+           and then Is_Enumeration_Type (Etype (N))
+
+           --  Exclude standard types. Most importantly we want to exclude the
+           --  standard character types, since we want to allow ranges like
+           --  '0' .. '9'. But also exclude Boolean since False .. True is OK.
+
+           and then Sloc (Root_Type (Etype (N))) /= Standard_Location
+
+           --  Exclude X'First .. X'Last if X is the same entity for both
+
+           and then not First_Last_Ref
+
+           --  Allow the range if in same unit as type declaration (or the
+           --  corresponding body or any of its subunits).
+
+           and then not In_Same_Extended_Unit (N, Etype (N))
+         then
+            Error_Msg
+              ("(style) explicit enumeration subrange not allowed",
+               Sloc (N));
+         end if;
+      end if;
+   end Check_Enumeration_Subrange;
+
    ---------------
    -- Check_EOF --
    ---------------
Index: styleg.ads
===================================================================
--- styleg.ads	(revision 164000)
+++ styleg.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-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- --
@@ -92,6 +92,10 @@  package Styleg is
    procedure Check_Dot_Dot;
    --  Called after scanning out dot dot to check spacing
 
+   procedure Check_Enumeration_Subrange (N : Node_Id);
+   --  Called to check a node that may be an N_Range node for an enumeration
+   --  subtype occurring other than in the defining unit of the type.
+
    procedure Check_EOF;
    --  Called after scanning out EOF mark
 
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb	(revision 164000)
+++ sem_ch13.adb	(working copy)
@@ -184,415 +184,410 @@  package body Sem_Ch13 is
    begin
       --  Processing depends on version of Ada
 
-      case Ada_Version is
+      --  For Ada 95, we just renumber bits within a storage unit. We do the
+      --  same for Ada 83 mode, since we recognize pragma Bit_Order in Ada 83,
+      --  and are free to add this extension.
 
-         --  For Ada 95, we just renumber bits within a storage unit. We do
-         --  the same for Ada 83 mode, since we recognize pragma Bit_Order
-         --  in Ada 83, and are free to add this extension.
+      if Ada_Version < Ada_2005 then
+         Comp := First_Component_Or_Discriminant (R);
+         while Present (Comp) loop
+            CC := Component_Clause (Comp);
 
-         when Ada_83 | Ada_95 =>
-            Comp := First_Component_Or_Discriminant (R);
-            while Present (Comp) loop
-               CC := Component_Clause (Comp);
+            --  If component clause is present, then deal with the non-default
+            --  bit order case for Ada 95 mode.
 
-               --  If component clause is present, then deal with the non-
-               --  default bit order case for Ada 95 mode.
+            --  We only do this processing for the base type, and in fact that
+            --  is important, since otherwise if there are record subtypes, we
+            --  could reverse the bits once for each subtype, which is wrong.
 
-               --  We only do this processing for the base type, and in
-               --  fact that's important, since otherwise if there are
-               --  record subtypes, we could reverse the bits once for
-               --  each subtype, which would be incorrect.
+            if Present (CC)
+              and then Ekind (R) = E_Record_Type
+            then
+               declare
+                  CFB : constant Uint    := Component_Bit_Offset (Comp);
+                  CSZ : constant Uint    := Esize (Comp);
+                  CLC : constant Node_Id := Component_Clause (Comp);
+                  Pos : constant Node_Id := Position (CLC);
+                  FB  : constant Node_Id := First_Bit (CLC);
 
-               if Present (CC)
-                 and then Ekind (R) = E_Record_Type
-               then
-                  declare
-                     CFB : constant Uint    := Component_Bit_Offset (Comp);
-                     CSZ : constant Uint    := Esize (Comp);
-                     CLC : constant Node_Id := Component_Clause (Comp);
-                     Pos : constant Node_Id := Position (CLC);
-                     FB  : constant Node_Id := First_Bit (CLC);
+                  Storage_Unit_Offset : constant Uint :=
+                                          CFB / System_Storage_Unit;
 
-                     Storage_Unit_Offset : constant Uint :=
-                                             CFB / System_Storage_Unit;
+                  Start_Bit : constant Uint :=
+                                CFB mod System_Storage_Unit;
 
-                     Start_Bit : constant Uint :=
-                                   CFB mod System_Storage_Unit;
+               begin
+                  --  Cases where field goes over storage unit boundary
 
-                  begin
-                     --  Cases where field goes over storage unit boundary
+                  if Start_Bit + CSZ > System_Storage_Unit then
 
-                     if Start_Bit + CSZ > System_Storage_Unit then
+                     --  Allow multi-byte field but generate warning
 
-                        --  Allow multi-byte field but generate warning
+                     if Start_Bit mod System_Storage_Unit = 0
+                       and then CSZ mod System_Storage_Unit = 0
+                     then
+                        Error_Msg_N
+                          ("multi-byte field specified with non-standard"
+                           & " Bit_Order?", CLC);
 
-                        if Start_Bit mod System_Storage_Unit = 0
-                          and then CSZ mod System_Storage_Unit = 0
-                        then
+                        if Bytes_Big_Endian then
                            Error_Msg_N
-                             ("multi-byte field specified with non-standard"
-                              & " Bit_Order?", CLC);
-
-                           if Bytes_Big_Endian then
-                              Error_Msg_N
-                                ("bytes are not reversed "
-                                 & "(component is big-endian)?", CLC);
-                           else
-                              Error_Msg_N
-                                ("bytes are not reversed "
-                                 & "(component is little-endian)?", CLC);
-                           end if;
-
-                           --  Do not allow non-contiguous field
-
+                             ("bytes are not reversed "
+                              & "(component is big-endian)?", CLC);
                         else
                            Error_Msg_N
-                             ("attempt to specify non-contiguous field "
-                              & "not permitted", CLC);
-                           Error_Msg_N
-                             ("\caused by non-standard Bit_Order "
-                              & "specified", CLC);
-                           Error_Msg_N
-                             ("\consider possibility of using "
-                              & "Ada 2005 mode here", CLC);
+                             ("bytes are not reversed "
+                              & "(component is little-endian)?", CLC);
                         end if;
 
-                        --  Case where field fits in one storage unit
+                        --  Do not allow non-contiguous field
 
                      else
-                        --  Give warning if suspicious component clause
+                        Error_Msg_N
+                          ("attempt to specify non-contiguous field "
+                           & "not permitted", CLC);
+                        Error_Msg_N
+                          ("\caused by non-standard Bit_Order "
+                           & "specified", CLC);
+                        Error_Msg_N
+                          ("\consider possibility of using "
+                           & "Ada 2005 mode here", CLC);
+                     end if;
 
-                        if Intval (FB) >= System_Storage_Unit
-                          and then Warn_On_Reverse_Bit_Order
-                        then
-                           Error_Msg_N
-                             ("?Bit_Order clause does not affect " &
-                              "byte ordering", Pos);
-                           Error_Msg_Uint_1 :=
-                             Intval (Pos) + Intval (FB) /
-                             System_Storage_Unit;
-                           Error_Msg_N
-                             ("?position normalized to ^ before bit " &
-                              "order interpreted", Pos);
-                        end if;
+                  --  Case where field fits in one storage unit
 
-                        --  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 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 storage_unit - 1.
-
-                        Set_Component_Bit_Offset
-                          (Comp,
-                           (Storage_Unit_Offset * System_Storage_Unit) +
-                             (System_Storage_Unit - 1) -
-                             (Start_Bit + CSZ - 1));
-
-                        Set_Normalized_First_Bit
-                          (Comp,
-                           Component_Bit_Offset (Comp) mod
-                             System_Storage_Unit);
-                     end if;
-                  end;
-               end if;
+                  else
+                     --  Give warning if suspicious component clause
 
-               Next_Component_Or_Discriminant (Comp);
-            end loop;
+                     if Intval (FB) >= System_Storage_Unit
+                       and then Warn_On_Reverse_Bit_Order
+                     then
+                        Error_Msg_N
+                          ("?Bit_Order clause does not affect " &
+                           "byte ordering", Pos);
+                        Error_Msg_Uint_1 :=
+                          Intval (Pos) + Intval (FB) /
+                          System_Storage_Unit;
+                        Error_Msg_N
+                          ("?position normalized to ^ before bit " &
+                           "order interpreted", Pos);
+                     end if;
 
-         --  For Ada 2005, we do machine scalar processing, as fully described
-         --  In AI-133. This involves gathering all components which start at
-         --  the same byte offset and processing them together
+                     --  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 are:
 
-         when Ada_05 .. Ada_Version_Type'Last =>
-            declare
-               Max_Machine_Scalar_Size : constant Uint :=
-                                           UI_From_Int
-                                             (Standard_Long_Long_Integer_Size);
-            --  We use this as the maximum machine scalar size
+                     --    First_Bit .. Last_Bit     Component_Bit_Offset
+                     --      old          new          old       new
 
-               Num_CC : Natural;
-               SSU    : constant Uint := UI_From_Int (System_Storage_Unit);
+                     --     0 .. 0       7 .. 7         0         7
+                     --     0 .. 1       6 .. 7         0         6
+                     --     0 .. 2       5 .. 7         0         5
+                     --     0 .. 7       0 .. 7         0         4
 
-            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.
+                     --     1 .. 1       6 .. 6         1         6
+                     --     1 .. 4       3 .. 6         1         3
+                     --     4 .. 7       0 .. 3         4         0
 
-               Num_CC := 0;
-               Comp   := First_Component_Or_Discriminant (R);
-               while Present (Comp) loop
-                  CC := Component_Clause (Comp);
+                     --  The rule is that the first bit is is obtained by
+                     --  subtracting the old ending bit from storage_unit - 1.
 
-                  if Present (CC) then
-                     declare
-                        Fbit : constant Uint :=
-                                 Static_Integer (First_Bit (CC));
+                     Set_Component_Bit_Offset
+                       (Comp,
+                        (Storage_Unit_Offset * System_Storage_Unit) +
+                          (System_Storage_Unit - 1) -
+                          (Start_Bit + CSZ - 1));
+
+                     Set_Normalized_First_Bit
+                       (Comp,
+                        Component_Bit_Offset (Comp) mod
+                          System_Storage_Unit);
+                  end if;
+               end;
+            end if;
 
-                     begin
-                        --  Case of component with size > max machine scalar
+            Next_Component_Or_Discriminant (Comp);
+         end loop;
 
-                        if Esize (Comp) > Max_Machine_Scalar_Size then
+      --  For Ada 2005, we do machine scalar processing, as fully described In
+      --  AI-133. This involves gathering all components which start at the
+      --  same byte offset and processing them together. Same approach is still
+      --  valid in later versions including Ada 2012.
 
-                           --  Must begin on byte boundary
+      else
+         declare
+            Max_Machine_Scalar_Size : constant Uint :=
+                                        UI_From_Int
+                                          (Standard_Long_Long_Integer_Size);
+            --  We use this as the maximum machine scalar size
 
-                           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;
+            Num_CC : Natural;
+            SSU    : constant Uint := UI_From_Int (System_Storage_Unit);
 
-                              Error_Msg_N
-                                ("\must be a multiple of ^ "
-                                 & "if size greater than ^",
-                                 First_Bit (CC));
+         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.
 
-                              --  Must end on byte boundary
+            Num_CC := 0;
+            Comp   := First_Component_Or_Discriminant (R);
+            while Present (Comp) loop
+               CC := Component_Clause (Comp);
 
-                           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;
+               if Present (CC) then
+                  declare
+                     Fbit : constant Uint :=
+                              Static_Integer (First_Bit (CC));
 
-                              Error_Msg_N
-                                ("\must be a multiple of ^ if size "
-                                 & "greater than ^",
-                                 Last_Bit (CC));
+                  begin
+                     --  Case of component with size > max machine scalar
 
-                              --  OK, give warning if enabled
+                     if Esize (Comp) > Max_Machine_Scalar_Size then
 
-                           elsif Warn_On_Reverse_Bit_Order then
-                              Error_Msg_N
-                                ("multi-byte field specified with "
-                                 & "  non-standard Bit_Order?", CC);
+                        --  Must begin on byte boundary
 
-                              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;
+                        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;
 
-                           --  Case where size is not greater than max machine
-                           --  scalar. For now, we just count these.
+                           Error_Msg_N
+                             ("\must be a multiple of ^ "
+                              & "if size greater than ^",
+                              First_Bit (CC));
 
-                        else
-                           Num_CC := Num_CC + 1;
-                        end if;
-                     end;
-                  end if;
+                           --  Must end on byte boundary
 
-                  Next_Component_Or_Discriminant (Comp);
-               end loop;
+                        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;
 
-               --  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.
-
-               Sort_CC : declare
-                  Comps : array (0 .. Num_CC) of Entity_Id;
-                  --  Array to collect component and discriminant entities. The
-                  --  data starts at index 1, the 0'th entry is for the sort
-                  --  routine.
-
-                  function CP_Lt (Op1, Op2 : Natural) return Boolean;
-                  --  Compare routine for Sort
-
-                  procedure CP_Move (From : Natural; To : Natural);
-                  --  Move routine for Sort
-
-                  package Sorting is new GNAT.Heap_Sort_G (CP_Move, CP_Lt);
-
-                  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 --
-                  -----------
+                           Error_Msg_N
+                             ("\must be a multiple of ^ if size "
+                              & "greater than ^",
+                              Last_Bit (CC));
 
-                  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 --
-                  -------------
+                           --  OK, give warning if enabled
 
-                  procedure CP_Move (From : Natural; To : Natural) is
-                  begin
-                     Comps (To) := Comps (From);
-                  end CP_Move;
+                        elsif Warn_On_Reverse_Bit_Order then
+                           Error_Msg_N
+                             ("multi-byte field specified with "
+                              & "  non-standard Bit_Order?", CC);
 
-               --  Start of processing for Sort_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;
 
-               begin
-                  --  Collect the component clauses
+                        --  Case where size is not greater than max machine
+                        --  scalar. For now, we just count these.
 
-                  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
+                     else
                         Num_CC := Num_CC + 1;
-                        Comps (Num_CC) := Comp;
                      end if;
+                  end;
+               end if;
 
-                     Next_Component_Or_Discriminant (Comp);
-                  end loop;
+               Next_Component_Or_Discriminant (Comp);
+            end loop;
 
-                  --  Sort by ascending position number
+            --  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.
+
+            Sort_CC : declare
+               Comps : array (0 .. Num_CC) of Entity_Id;
+               --  Array to collect component and discriminant entities. The
+               --  data starts at index 1, the 0'th entry is for the sort
+               --  routine.
+
+               function CP_Lt (Op1, Op2 : Natural) return Boolean;
+               --  Compare routine for Sort
+
+               procedure CP_Move (From : Natural; To : Natural);
+               --  Move routine for Sort
+
+               package Sorting is new GNAT.Heap_Sort_G (CP_Move, CP_Lt);
+
+               Start : Natural;
+               Stop  : Natural;
+               --  Start and stop positions in the component list of the 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 --
+               -----------
 
-                  Sorting.Sort (Num_CC);
+               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 --
+               -------------
 
-                  --  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.
+               procedure CP_Move (From : Natural; To : Natural) is
+               begin
+                  Comps (To) := Comps (From);
+               end CP_Move;
 
-                  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;
+               --  Start of processing for Sort_CC
 
-                     --  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;
+            begin
+               --  Collect the component clauses
 
-                     --  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:
+               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;
 
-                     --    First_Bit .. Last_Bit     Component_Bit_Offset
-                     --      old          new          old       new
+                  Next_Component_Or_Discriminant (Comp);
+               end loop;
 
-                     --     0 .. 0       7 .. 7         0         7
-                     --     0 .. 1       6 .. 7         0         6
-                     --     0 .. 2       5 .. 7         0         5
-                     --     0 .. 7       0 .. 7         0         4
+               --  Sort by ascending position number
 
-                     --     1 .. 1       6 .. 6         1         6
-                     --     1 .. 4       3 .. 6         1         3
-                     --     4 .. 7       0 .. 3         4         0
+               Sorting.Sort (Num_CC);
 
-                     --  The general rule is that the first bit is obtained by
-                     --  subtracting the old ending bit from machine scalar
-                     --  size - 1.
+               --  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 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;
 
-                     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));
+                  --  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;
 
-                        begin
-                           if Warn_On_Reverse_Bit_Order then
-                              Error_Msg_Uint_1 := MSS;
-                              Error_Msg_N
-                                ("info: 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
-                                   ("?\info: big-endian range for "
-                                    & "component & is ^ .. ^",
-                                    First_Bit (CC), Comp);
-                              else
-                                 Error_Msg_NE
-                                   ("?\info: little-endian range "
-                                    & "for component & is ^ .. ^",
-                                    First_Bit (CC), Comp);
-                              end if;
+                  --  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 rule is that the first bit 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
+                             ("info: 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
+                                ("?\info: big-endian range for "
+                                 & "component & is ^ .. ^",
+                                 First_Bit (CC), Comp);
+                           else
+                              Error_Msg_NE
+                                ("?\info: 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;
+                        Set_Component_Bit_Offset (Comp, Pos * SSU + NFB);
+                        Set_Normalized_First_Bit (Comp, NFB mod SSU);
+                     end;
                   end loop;
-               end Sort_CC;
-            end;
-      end case;
+               end loop;
+            end Sort_CC;
+         end;
+      end if;
    end Adjust_Record_For_Reverse_Bit_Order;
 
    --------------------------------------