atree.ads, atree.adb (New_Copy_Tree): If hash table is being used and itype is visited...

2007-08-14  Ed Schonberg  <schonberg@adacore.com>
	    Robert Dewar  <dewar@adacore.com>

	* atree.ads, atree.adb (New_Copy_Tree): If hash table is being used and
	itype is visited, make an entry into table to link associated node and
	new itype.
	Add comments and correct harmless error in Build_NCT_Hash_Tables
	(Array_Aggr_Subtype): Associate each itype created for an index type to
	the corresponding range construct, and not to the aggregate itself. to
	maintain a one-to-one correspondence between itype and its associated
	node, to prevent errors when complex expression is copied.
	Fix mishandling of multiple levels of parens

	* sem_aggr.adb: Create a limited view of an incomplete type, to make
	treatment of limited views uniform for all visible declarations in a
	limited_withed package.
	(New_Copy_Tree): If hash table is being used and itype is visited,
	make an entry into table to link associated node and new itype.
	(Resolve_Record_Aggregate): Do not add an others box association for a
	discriminated record component that has only discriminants, when there
	is a box association for the component itself.

	* par-ch4.adb: Fix mishandling of multiple levels of parens

From-SVN: r127412

gcc/ada/atree.adb

@@ -535,6 +535,32 @@ package body Atree is
    subtype NCT_Header_Num is Int range 0 .. 511;
    --  Defines range of headers in hash tables (512 headers)
 
+   --------------------------
+   -- Paren_Count Handling --
+   --------------------------
+
+   --  As noted in the spec, the paren count in a sub-expression node has
+   --  four possible values 0,1,2, and 3. The value 3 really means 3 or more,
+   --  and we use an auxiliary serially scanned table to record the actual
+   --  count. A serial search is fine, only pathological programs will use
+   --  entries in this table. Normal programs won't use it at all.
+
+   type Paren_Count_Entry is record
+      Nod   : Node_Id;
+      --  The node to which this count applies
+
+      Count : Nat range 3 .. Nat'Last;
+      --  The count of parentheses, which will be in the indicated range
+   end record;
+
+   package Paren_Counts is new Table.Table (
+     Table_Component_Type => Paren_Count_Entry,
+     Table_Index_Type     => Int,
+     Table_Low_Bound      => 0,
+     Table_Initial        => 10,
+     Table_Increment      => 200,
+     Table_Name           => "Paren_Counts");
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -590,6 +616,15 @@ package body Atree is
          Node_Count := Node_Count + 1;
       end if;
 
+      --  Specifically copy Paren_Count to deal with creating new table entry
+      --  if the parentheses count is at the maximum possible value already.
+
+      if Present (Src) and then Nkind (Src) in N_Subexpr then
+         Set_Paren_Count (New_Id, Paren_Count (Src));
+      end if;
+
+      --  Set extension nodes if required
+
       if With_Extension then
          Nodes.Append (Ext1);
          Nodes.Append (Ext2);
@@ -608,7 +643,7 @@ package body Atree is
 
    function Analyzed (N : Node_Id) return Boolean is
    begin
-      pragma Assert (N in Nodes.First .. Nodes.Last);
+      pragma Assert (N <= Nodes.Last);
       return Nodes.Table (N).Analyzed;
    end Analyzed;
 
@@ -622,7 +657,7 @@ package body Atree is
       Save_Link    : constant Union_Id   := Nodes.Table (N).Link;
       Save_CFS     : constant Boolean    := Nodes.Table (N).Comes_From_Source;
       Save_Posted  : constant Boolean    := Nodes.Table (N).Error_Posted;
-      Par_Count    : Paren_Count_Type    := 0;
+      Par_Count    : Nat                 := 0;
 
    begin
       if Nkind (N) in N_Subexpr then
@@ -648,7 +683,7 @@ package body Atree is
 
    function Comes_From_Source (N : Node_Id) return Boolean is
    begin
-      pragma Assert (N in Nodes.First .. Nodes.Last);
+      pragma Assert (N <= Nodes.Last);
       return Nodes.Table (N).Comes_From_Source;
    end Comes_From_Source;
 
@@ -675,6 +710,15 @@ package body Atree is
       Nodes.Table (Destination).In_List := Save_In_List;
       Nodes.Table (Destination).Link    := Save_Link;
 
+      --  Specifically set Paren_Count to make sure auxiliary table entry
+      --  gets correctly made if the parentheses count is at the max value.
+
+      if Nkind (Destination) in N_Subexpr then
+         Set_Paren_Count (Destination, Paren_Count (Source));
+      end if;
+
+      --  Deal with copying extension nodes if present
+
       if Has_Extension (Source) then
          pragma Assert (Has_Extension (Destination));
          Nodes.Table (Destination + 1) := Nodes.Table (Source + 1);
@@ -923,7 +967,7 @@ package body Atree is
 
    function Error_Posted (N : Node_Id) return Boolean is
    begin
-      pragma Assert (N in Nodes.First .. Nodes.Last);
+      pragma Assert (N <= Nodes.Last);
       return Nodes.Table (N).Error_Posted;
    end Error_Posted;
 
@@ -1092,6 +1136,7 @@ package body Atree is
       Node_Count := 0;
       Atree_Private_Part.Nodes.Init;
       Orig_Nodes.Init;
+      Paren_Counts.Init;
 
       --  Allocate Empty node
 
@@ -1360,9 +1405,11 @@ package body Atree is
          Elmt := First_Elmt (Actual_Map);
          while Present (Elmt) loop
             Ent := Node (Elmt);
+
+            --  Get new entity, and associate old and new
+
             Next_Elmt (Elmt);
             NCT_Assoc.Set (Ent, Node (Elmt));
-            Next_Elmt (Elmt);
 
             if Is_Type (Ent) then
                declare
@@ -1371,10 +1418,17 @@ package body Atree is
 
                begin
                   if Present (Anode) then
+
+                     --  Enter a link between the associated node of the
+                     --  old Itype and the new Itype, for updating later
+                     --  when node is copied.
+
                      NCT_Itype_Assoc.Set (Anode, Node (Elmt));
                   end if;
                end;
             end if;
+
+            Next_Elmt (Elmt);
          end loop;
 
          NCT_Hash_Tables_Used := True;
@@ -1877,6 +1931,7 @@ package body Atree is
             if NCT_Hash_Tables_Used then
 
                Ent := NCT_Assoc.Get (Associated_Node_For_Itype (Old_Itype));
+
                if Present (Ent) then
                   Set_Associated_Node_For_Itype (New_Itype, Ent);
                end if;
@@ -1884,6 +1939,13 @@ package body Atree is
                Ent := NCT_Itype_Assoc.Get (Old_Itype);
                if Present (Ent) then
                   Set_Associated_Node_For_Itype (Ent, New_Itype);
+
+               --  If the hash table has no association for this Itype and
+               --  its associated node, enter one now.
+
+               else
+                  NCT_Itype_Assoc.Set
+                    (Associated_Node_For_Itype (Old_Itype), New_Itype);
                end if;
 
             --  Case of hash tables not used
@@ -2251,11 +2313,11 @@ package body Atree is
    -- Paren_Count --
    -----------------
 
-   function Paren_Count (N : Node_Id) return Paren_Count_Type is
-      C : Paren_Count_Type := 0;
+   function Paren_Count (N : Node_Id) return Nat is
+      C : Nat := 0;
 
    begin
-      pragma Assert (N in Nodes.First .. Nodes.Last);
+      pragma Assert (N <= Nodes.Last);
 
       if Nodes.Table (N).Pflag1 then
          C := C + 1;
@@ -2265,7 +2327,22 @@ package body Atree is
          C := C + 2;
       end if;
 
-      return C;
+      --  Value of 0,1,2 returned as is
+
+      if C <= 2 then
+         return C;
+
+      --  Value of 3 means we search the table, and we must find an entry
+
+      else
+         for J in Paren_Counts.First .. Paren_Counts.Last loop
+            if N = Paren_Counts.Table (J).Nod then
+               return Paren_Counts.Table (J).Count;
+            end if;
+         end loop;
+
+         raise Program_Error;
+      end if;
    end Paren_Count;
 
    ------------
@@ -2375,11 +2452,10 @@ package body Atree is
    -------------
 
    procedure Rewrite (Old_Node, New_Node : Node_Id) is
-
       Old_Error_P : constant Boolean  := Nodes.Table (Old_Node).Error_Posted;
       --  This fields is always preserved in the new node
 
-      Old_Paren_Count     : Paren_Count_Type;
+      Old_Paren_Count     : Nat;
       Old_Must_Not_Freeze : Boolean;
       --  These fields are preserved in the new node only if the new node
       --  and the old node are both subexpression nodes.
@@ -2443,7 +2519,7 @@ package body Atree is
 
    procedure Set_Comes_From_Source (N : Node_Id; Val : Boolean) is
    begin
-      pragma Assert (N in Nodes.First .. Nodes.Last);
+      pragma Assert (N <= Nodes.Last);
       Nodes.Table (N).Comes_From_Source := Val;
    end Set_Comes_From_Source;
 
@@ -2492,11 +2568,31 @@ package body Atree is
    -- Set_Paren_Count --
    ---------------------
 
-   procedure Set_Paren_Count (N : Node_Id; Val : Paren_Count_Type) is
+   procedure Set_Paren_Count (N : Node_Id; Val : Nat) is
    begin
       pragma Assert (Nkind (N) in N_Subexpr);
-      Nodes.Table (N).Pflag1 := (Val mod 2 /= 0);
-      Nodes.Table (N).Pflag2 := (Val >= 2);
+
+      --  Value of 0,1,2 stored as is
+
+      if Val <= 2 then
+         Nodes.Table (N).Pflag1 := (Val mod 2 /= 0);
+         Nodes.Table (N).Pflag2 := (Val = 2);
+
+      --  Value of 3 or greater stores 3 in node and makes table entry
+
+      else
+         Nodes.Table (N).Pflag1 := True;
+         Nodes.Table (N).Pflag2 := True;
+
+         for J in Paren_Counts.First .. Paren_Counts.Last loop
+            if N = Paren_Counts.Table (J).Nod then
+               Paren_Counts.Table (J).Count := Val;
+               return;
+            end if;
+         end loop;
+
+         Paren_Counts.Append ((Nod => N, Count => Val));
+      end if;
    end Set_Paren_Count;
 
    ----------------
@@ -2673,6 +2769,7 @@ package body Atree is
       Tree_Read_Int (Node_Count);
       Nodes.Tree_Read;
       Orig_Nodes.Tree_Read;
+      Paren_Counts.Tree_Read;
    end Tree_Read;
 
    ----------------
@@ -2684,6 +2781,7 @@ package body Atree is
       Tree_Write_Int (Node_Count);
       Nodes.Tree_Write;
       Orig_Nodes.Tree_Write;
+      Paren_Counts.Tree_Write;
    end Tree_Write;
 
    ------------------------------
@@ -2694,31 +2792,31 @@ package body Atree is
 
       function Field1 (N : Node_Id) return Union_Id is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Nodes.Table (N).Field1;
       end Field1;
 
       function Field2 (N : Node_Id) return Union_Id is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Nodes.Table (N).Field2;
       end Field2;
 
       function Field3 (N : Node_Id) return Union_Id is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Nodes.Table (N).Field3;
       end Field3;
 
       function Field4 (N : Node_Id) return Union_Id is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Nodes.Table (N).Field4;
       end Field4;
 
       function Field5 (N : Node_Id) return Union_Id is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Nodes.Table (N).Field5;
       end Field5;
 
@@ -2862,31 +2960,31 @@ package body Atree is
 
       function Node1 (N : Node_Id) return Node_Id is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Node_Id (Nodes.Table (N).Field1);
       end Node1;
 
       function Node2 (N : Node_Id) return Node_Id is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Node_Id (Nodes.Table (N).Field2);
       end Node2;
 
       function Node3 (N : Node_Id) return Node_Id is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Node_Id (Nodes.Table (N).Field3);
       end Node3;
 
       function Node4 (N : Node_Id) return Node_Id is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Node_Id (Nodes.Table (N).Field4);
       end Node4;
 
       function Node5 (N : Node_Id) return Node_Id is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Node_Id (Nodes.Table (N).Field5);
       end Node5;
 
@@ -3030,31 +3128,31 @@ package body Atree is
 
       function List1 (N : Node_Id) return List_Id is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return List_Id (Nodes.Table (N).Field1);
       end List1;
 
       function List2 (N : Node_Id) return List_Id is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return List_Id (Nodes.Table (N).Field2);
       end List2;
 
       function List3 (N : Node_Id) return List_Id is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return List_Id (Nodes.Table (N).Field3);
       end List3;
 
       function List4 (N : Node_Id) return List_Id is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return List_Id (Nodes.Table (N).Field4);
       end List4;
 
       function List5 (N : Node_Id) return List_Id is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return List_Id (Nodes.Table (N).Field5);
       end List5;
 
@@ -3071,7 +3169,7 @@ package body Atree is
       end List14;
 
       function Elist1 (N : Node_Id) return Elist_Id is
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Value : constant Union_Id := Nodes.Table (N).Field1;
       begin
          if Value = 0 then
@@ -3082,7 +3180,7 @@ package body Atree is
       end Elist1;
 
       function Elist2 (N : Node_Id) return Elist_Id is
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Value : constant Union_Id := Nodes.Table (N).Field2;
       begin
          if Value = 0 then
@@ -3093,7 +3191,7 @@ package body Atree is
       end Elist2;
 
       function Elist3 (N : Node_Id) return Elist_Id is
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Value : constant Union_Id := Nodes.Table (N).Field3;
       begin
          if Value = 0 then
@@ -3104,7 +3202,7 @@ package body Atree is
       end Elist3;
 
       function Elist4 (N : Node_Id) return Elist_Id is
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Value : constant Union_Id := Nodes.Table (N).Field4;
       begin
          if Value = 0 then
@@ -3204,24 +3302,24 @@ package body Atree is
 
       function Name1 (N : Node_Id) return Name_Id is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Name_Id (Nodes.Table (N).Field1);
       end Name1;
 
       function Name2 (N : Node_Id) return Name_Id is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Name_Id (Nodes.Table (N).Field2);
       end Name2;
 
       function Str3 (N : Node_Id) return String_Id is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return String_Id (Nodes.Table (N).Field3);
       end Str3;
 
       function Uint2 (N : Node_Id) return Uint is
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          U : constant Union_Id := Nodes.Table (N).Field2;
       begin
          if U = 0 then
@@ -3232,7 +3330,7 @@ package body Atree is
       end Uint2;
 
       function Uint3 (N : Node_Id) return Uint is
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          U : constant Union_Id := Nodes.Table (N).Field3;
       begin
          if U = 0 then
@@ -3243,7 +3341,7 @@ package body Atree is
       end Uint3;
 
       function Uint4 (N : Node_Id) return Uint is
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          U : constant Union_Id := Nodes.Table (N).Field4;
       begin
          if U = 0 then
@@ -3254,7 +3352,7 @@ package body Atree is
       end Uint4;
 
       function Uint5 (N : Node_Id) return Uint is
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          U : constant Union_Id := Nodes.Table (N).Field5;
       begin
          if U = 0 then
@@ -3387,7 +3485,7 @@ package body Atree is
 
       function Ureal3 (N : Node_Id) return Ureal is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return From_Union (Nodes.Table (N).Field3);
       end Ureal3;
 
@@ -3405,91 +3503,91 @@ package body Atree is
 
       function Flag4 (N : Node_Id) return Boolean is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Nodes.Table (N).Flag4;
       end Flag4;
 
       function Flag5 (N : Node_Id) return Boolean is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Nodes.Table (N).Flag5;
       end Flag5;
 
       function Flag6 (N : Node_Id) return Boolean is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Nodes.Table (N).Flag6;
       end Flag6;
 
       function Flag7 (N : Node_Id) return Boolean is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Nodes.Table (N).Flag7;
       end Flag7;
 
       function Flag8 (N : Node_Id) return Boolean is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Nodes.Table (N).Flag8;
       end Flag8;
 
       function Flag9 (N : Node_Id) return Boolean is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Nodes.Table (N).Flag9;
       end Flag9;
 
       function Flag10 (N : Node_Id) return Boolean is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Nodes.Table (N).Flag10;
       end Flag10;
 
       function Flag11 (N : Node_Id) return Boolean is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Nodes.Table (N).Flag11;
       end Flag11;
 
       function Flag12 (N : Node_Id) return Boolean is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Nodes.Table (N).Flag12;
       end Flag12;
 
       function Flag13 (N : Node_Id) return Boolean is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Nodes.Table (N).Flag13;
       end Flag13;
 
       function Flag14 (N : Node_Id) return Boolean is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Nodes.Table (N).Flag14;
       end Flag14;
 
       function Flag15 (N : Node_Id) return Boolean is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Nodes.Table (N).Flag15;
       end Flag15;
 
       function Flag16 (N : Node_Id) return Boolean is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Nodes.Table (N).Flag16;
       end Flag16;
 
       function Flag17 (N : Node_Id) return Boolean is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Nodes.Table (N).Flag17;
       end Flag17;
 
       function Flag18 (N : Node_Id) return Boolean is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          return Nodes.Table (N).Flag18;
       end Flag18;
 
@@ -4767,37 +4865,37 @@ package body Atree is
 
       procedure Set_Nkind (N : Node_Id; Val : Node_Kind) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Nkind := Val;
       end Set_Nkind;
 
       procedure Set_Field1 (N : Node_Id; Val : Union_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Field1 := Val;
       end Set_Field1;
 
       procedure Set_Field2 (N : Node_Id; Val : Union_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Field2 := Val;
       end Set_Field2;
 
       procedure Set_Field3 (N : Node_Id; Val : Union_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Field3 := Val;
       end Set_Field3;
 
       procedure Set_Field4 (N : Node_Id; Val : Union_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Field4 := Val;
       end Set_Field4;
 
       procedure Set_Field5 (N : Node_Id; Val : Union_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Field5 := Val;
       end Set_Field5;
 
@@ -4941,31 +5039,31 @@ package body Atree is
 
       procedure Set_Node1 (N : Node_Id; Val : Node_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Field1 := Union_Id (Val);
       end Set_Node1;
 
       procedure Set_Node2 (N : Node_Id; Val : Node_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Field2 := Union_Id (Val);
       end Set_Node2;
 
       procedure Set_Node3 (N : Node_Id; Val : Node_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Field3 := Union_Id (Val);
       end Set_Node3;
 
       procedure Set_Node4 (N : Node_Id; Val : Node_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Field4 := Union_Id (Val);
       end Set_Node4;
 
       procedure Set_Node5 (N : Node_Id; Val : Node_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Field5 := Union_Id (Val);
       end Set_Node5;
 
@@ -5109,31 +5207,31 @@ package body Atree is
 
       procedure Set_List1 (N : Node_Id; Val : List_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Field1 := Union_Id (Val);
       end Set_List1;
 
       procedure Set_List2 (N : Node_Id; Val : List_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Field2 := Union_Id (Val);
       end Set_List2;
 
       procedure Set_List3 (N : Node_Id; Val : List_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Field3 := Union_Id (Val);
       end Set_List3;
 
       procedure Set_List4 (N : Node_Id; Val : List_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Field4 := Union_Id (Val);
       end Set_List4;
 
       procedure Set_List5 (N : Node_Id; Val : List_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Field5 := Union_Id (Val);
       end Set_List5;
 
@@ -5219,43 +5317,43 @@ package body Atree is
 
       procedure Set_Name1 (N : Node_Id; Val : Name_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Field1 := Union_Id (Val);
       end Set_Name1;
 
       procedure Set_Name2 (N : Node_Id; Val : Name_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Field2 := Union_Id (Val);
       end Set_Name2;
 
       procedure Set_Str3 (N : Node_Id; Val : String_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Field3 := Union_Id (Val);
       end Set_Str3;
 
       procedure Set_Uint2 (N : Node_Id; Val : Uint) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Field2 := To_Union (Val);
       end Set_Uint2;
 
       procedure Set_Uint3 (N : Node_Id; Val : Uint) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Field3 := To_Union (Val);
       end Set_Uint3;
 
       procedure Set_Uint4 (N : Node_Id; Val : Uint) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Field4 := To_Union (Val);
       end Set_Uint4;
 
       procedure Set_Uint5 (N : Node_Id; Val : Uint) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Field5 := To_Union (Val);
       end Set_Uint5;
 
@@ -5327,7 +5425,7 @@ package body Atree is
 
       procedure Set_Ureal3 (N : Node_Id; Val : Ureal) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Field3 := To_Union (Val);
       end Set_Ureal3;
 
@@ -5345,91 +5443,91 @@ package body Atree is
 
       procedure Set_Flag4 (N : Node_Id; Val : Boolean) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Flag4 := Val;
       end Set_Flag4;
 
       procedure Set_Flag5 (N : Node_Id; Val : Boolean) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Flag5 := Val;
       end Set_Flag5;
 
       procedure Set_Flag6 (N : Node_Id; Val : Boolean) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Flag6 := Val;
       end Set_Flag6;
 
       procedure Set_Flag7 (N : Node_Id; Val : Boolean) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Flag7 := Val;
       end Set_Flag7;
 
       procedure Set_Flag8 (N : Node_Id; Val : Boolean) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Flag8 := Val;
       end Set_Flag8;
 
       procedure Set_Flag9 (N : Node_Id; Val : Boolean) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Flag9 := Val;
       end Set_Flag9;
 
       procedure Set_Flag10 (N : Node_Id; Val : Boolean) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Flag10 := Val;
       end Set_Flag10;
 
       procedure Set_Flag11 (N : Node_Id; Val : Boolean) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Flag11 := Val;
       end Set_Flag11;
 
       procedure Set_Flag12 (N : Node_Id; Val : Boolean) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Flag12 := Val;
       end Set_Flag12;
 
       procedure Set_Flag13 (N : Node_Id; Val : Boolean) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Flag13 := Val;
       end Set_Flag13;
 
       procedure Set_Flag14 (N : Node_Id; Val : Boolean) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Flag14 := Val;
       end Set_Flag14;
 
       procedure Set_Flag15 (N : Node_Id; Val : Boolean) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Flag15 := Val;
       end Set_Flag15;
 
       procedure Set_Flag16 (N : Node_Id; Val : Boolean) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Flag16 := Val;
       end Set_Flag16;
 
       procedure Set_Flag17 (N : Node_Id; Val : Boolean) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Flag17 := Val;
       end Set_Flag17;
 
       procedure Set_Flag18 (N : Node_Id; Val : Boolean) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          Nodes.Table (N).Flag18 := Val;
       end Set_Flag18;
 
@@ -6993,42 +7091,62 @@ package body Atree is
 
       procedure Set_Node1_With_Parent (N : Node_Id; Val : Node_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
-         if Val > Error then Set_Parent (Val, N); end if;
+         pragma Assert (N <= Nodes.Last);
+
+         if Val > Error then
+            Set_Parent (Val, N);
+         end if;
+
          Set_Node1 (N, Val);
       end Set_Node1_With_Parent;
 
       procedure Set_Node2_With_Parent (N : Node_Id; Val : Node_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
-         if Val > Error then Set_Parent (Val, N); end if;
+         pragma Assert (N <= Nodes.Last);
+
+         if Val > Error then
+            Set_Parent (Val, N);
+         end if;
+
          Set_Node2 (N, Val);
       end Set_Node2_With_Parent;
 
       procedure Set_Node3_With_Parent (N : Node_Id; Val : Node_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
-         if Val > Error then Set_Parent (Val, N); end if;
+         pragma Assert (N <= Nodes.Last);
+
+         if Val > Error then
+            Set_Parent (Val, N);
+         end if;
+
          Set_Node3 (N, Val);
       end Set_Node3_With_Parent;
 
       procedure Set_Node4_With_Parent (N : Node_Id; Val : Node_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
-         if Val > Error then Set_Parent (Val, N); end if;
+         pragma Assert (N <= Nodes.Last);
+
+         if Val > Error then
+            Set_Parent (Val, N);
+         end if;
+
          Set_Node4 (N, Val);
       end Set_Node4_With_Parent;
 
       procedure Set_Node5_With_Parent (N : Node_Id; Val : Node_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
-         if Val > Error then Set_Parent (Val, N); end if;
+         pragma Assert (N <= Nodes.Last);
+
+         if Val > Error then
+            Set_Parent (Val, N);
+         end if;
+
          Set_Node5 (N, Val);
       end Set_Node5_With_Parent;
 
       procedure Set_List1_With_Parent (N : Node_Id; Val : List_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          if Val /= No_List and then Val /= Error_List then
             Set_Parent (Val, N);
          end if;
@@ -7037,7 +7155,7 @@ package body Atree is
 
       procedure Set_List2_With_Parent (N : Node_Id; Val : List_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          if Val /= No_List and then Val /= Error_List then
             Set_Parent (Val, N);
          end if;
@@ -7046,7 +7164,7 @@ package body Atree is
 
       procedure Set_List3_With_Parent (N : Node_Id; Val : List_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          if Val /= No_List and then Val /= Error_List then
             Set_Parent (Val, N);
          end if;
@@ -7055,7 +7173,7 @@ package body Atree is
 
       procedure Set_List4_With_Parent (N : Node_Id; Val : List_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          if Val /= No_List and then Val /= Error_List then
             Set_Parent (Val, N);
          end if;
@@ -7064,7 +7182,7 @@ package body Atree is
 
       procedure Set_List5_With_Parent (N : Node_Id; Val : List_Id) is
       begin
-         pragma Assert (N in Nodes.First .. Nodes.Last);
+         pragma Assert (N <= Nodes.Last);
          if Val /= No_List and then Val /= Error_List then
             Set_Parent (Val, N);
          end if;

gcc/ada/atree.ads

@@ -94,12 +94,11 @@ package Atree is
    --   Rewrite_Ins   A flag set if a node is marked as a rewrite inserted
    --                 node as a result of a call to Mark_Rewrite_Insertion.
 
-   --   Paren_Count   A 2-bit count used on expression nodes to indicate
-   --                 the level of parentheses. Up to 3 levels can be
-   --                 accomodated. Anything more than 3 levels is treated
-   --                 as 3 levels (conformance tests that complain about
-   --                 this are hereby deemed pathological!). Set to zero
-   --                 for non-subexpression nodes.
+   --   Paren_Count   A 2-bit count used in sub-expression nodes to indicate
+   --                 the level of parentheses. The settings are 0,1,2 and
+   --                 3 for many. If the value is 3, then an auxiliary table
+   --                 is used to indicate the real value. Set to zero for
+   --                 non-subexpression nodes.
 
    --   Comes_From_Source
    --                 This flag is present in all nodes. It is set if the
@@ -203,10 +202,6 @@ package Atree is
    --   Elist7-Elist28, Uint7-Uint28, Ureal7-Ureal28). Note that not all
    --   these functions are defined, only the ones that are actually used.
 
-   type Paren_Count_Type is mod 4;
-   for Paren_Count_Type'Size use 2;
-   --  Type used for Paren_Count field
-
    function Last_Node_Id return Node_Id;
    pragma Inline (Last_Node_Id);
    --  Returns Id of last allocated node Id
@@ -548,7 +543,7 @@ package Atree is
 
    --  The result returned by Traverse is Abandon if processing was terminated
    --  by a call to Process returning Abandon, otherwise it is OK (meaning that
-   --  all calls to process returned either OK or Skip).
+   --  all calls to process returned either OK, OK_Orig, or Skip).
 
    generic
      with function Process (N : Node_Id) return Traverse_Result is <>;
@@ -579,7 +574,7 @@ package Atree is
    function Sloc              (N : Node_Id) return Source_Ptr;
    pragma Inline (Sloc);
 
-   function Paren_Count       (N : Node_Id) return Paren_Count_Type;
+   function Paren_Count       (N : Node_Id) return Nat;
    pragma Inline (Paren_Count);
 
    function Parent            (N : Node_Id) return Node_Id;
@@ -623,7 +618,7 @@ package Atree is
    procedure Set_Sloc         (N : Node_Id; Val : Source_Ptr);
    pragma Inline (Set_Sloc);
 
-   procedure Set_Paren_Count  (N : Node_Id; Val : Paren_Count_Type);
+   procedure Set_Paren_Count  (N : Node_Id; Val : Nat);
    pragma Inline (Set_Paren_Count);
 
    procedure Set_Parent       (N : Node_Id; Val : Node_Id);

gcc/ada/par-ch4.adb

@@ -69,7 +69,7 @@ package body Ch4 is
 
    procedure Bad_Range_Attribute (Loc : Source_Ptr) is
    begin
-      Error_Msg ("range attribute cannot be used in expression", Loc);
+      Error_Msg ("range attribute cannot be used in expression!", Loc);
       Resync_Expression;
    end Bad_Range_Attribute;
 
@@ -1267,18 +1267,14 @@ package body Ch4 is
             then
                Error_Msg
                  ("|parentheses not allowed for range attribute", Lparen_Sloc);
+               Scan; -- past right paren
                return Expr_Node;
             end if;
 
-            --  Bump paren count of expression, note that if the paren count
-            --  is already at the maximum, then we leave it alone. This will
-            --  cause some failures in pathalogical conformance tests, which
-            --  we do not shed a tear over!
+            --  Bump paren count of expression
 
             if Expr_Node /= Error then
-               if Paren_Count (Expr_Node) /= Paren_Count_Type'Last then
-                  Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
-               end if;
+               Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
             end if;
 
             T_Right_Paren; -- past right paren (error message if none)
@@ -1577,11 +1573,13 @@ package body Ch4 is
    --  called in all contexts where a right parenthesis cannot legitimately
    --  follow an expression.
 
-   --  Error recovery: can raise Error_Resync
+   --  Error recovery: can not raise Error_Resync
 
    function P_Expression_No_Right_Paren return Node_Id is
+      Expr : constant Node_Id := P_Expression;
    begin
-      return No_Right_Paren (P_Expression);
+      Check_No_Right_Paren;
+      return Expr;
    end P_Expression_No_Right_Paren;
 
    ----------------------------------------
@@ -1805,7 +1803,10 @@ package body Ch4 is
 
          else
             if Token = Tok_Double_Asterisk then
-               if Style_Check then Style.Check_Exponentiation_Operator; end if;
+               if Style_Check then
+                  Style.Check_Exponentiation_Operator;
+               end if;
+
                Node2 := New_Node (N_Op_Expon, Token_Ptr);
                Scan; -- past **
                Set_Left_Opnd (Node2, Node1);
@@ -1818,7 +1819,11 @@ package body Ch4 is
                exit when Token not in Token_Class_Mulop;
                Tokptr := Token_Ptr;
                Node2 := New_Node (P_Multiplying_Operator, Tokptr);
-               if Style_Check then Style.Check_Binary_Operator; end if;
+
+               if Style_Check then
+                  Style.Check_Binary_Operator;
+               end if;
+
                Scan; -- past operator
                Set_Left_Opnd (Node2, Node1);
                Set_Right_Opnd (Node2, P_Factor);
@@ -1830,7 +1835,11 @@ package body Ch4 is
                exit when Token not in Token_Class_Binary_Addop;
                Tokptr := Token_Ptr;
                Node2 := New_Node (P_Binary_Adding_Operator, Tokptr);
-               if Style_Check then Style.Check_Binary_Operator; end if;
+
+               if Style_Check then
+                  Style.Check_Binary_Operator;
+               end if;
+
                Scan; -- past operator
                Set_Left_Opnd (Node2, Node1);
                Set_Right_Opnd (Node2, P_Term);
@@ -1849,7 +1858,11 @@ package body Ch4 is
          if Token in Token_Class_Unary_Addop then
             Tokptr := Token_Ptr;
             Node1 := New_Node (P_Unary_Adding_Operator, Tokptr);
-            if Style_Check then Style.Check_Unary_Plus_Or_Minus; end if;
+
+            if Style_Check then
+               Style.Check_Unary_Plus_Or_Minus;
+            end if;
+
             Scan; -- past operator
             Set_Right_Opnd (Node1, P_Term);
             Set_Op_Name (Node1);
@@ -1951,6 +1964,39 @@ package body Ch4 is
       Attr_Node : Node_Id;
 
    begin
+      --  We don't just want to roar ahead and call P_Simple_Expression
+      --  here, since we want to handle the case of a parenthesized range
+      --  attribute cleanly.
+
+      if Token = Tok_Left_Paren then
+         declare
+            Lptr       : constant Source_Ptr := Token_Ptr;
+            Scan_State : Saved_Scan_State;
+
+         begin
+            Save_Scan_State (Scan_State);
+            Scan; -- past left paren
+            Sexpr := P_Simple_Expression;
+
+            if Token = Tok_Apostrophe then
+               Attr_Node := P_Range_Attribute_Reference (Sexpr);
+               Expr_Form := EF_Range_Attr;
+
+               if Token = Tok_Right_Paren then
+                  Scan; -- scan past right paren if present
+               end if;
+
+               Error_Msg ("parentheses not allowed for range attribute", Lptr);
+
+               return Attr_Node;
+            end if;
+
+            Restore_Scan_State (Scan_State);
+         end;
+      end if;
+
+      --  Here after dealing with parenthesized range attribute
+
       Sexpr := P_Simple_Expression;
 
       if Token = Tok_Apostrophe then
@@ -2007,7 +2053,11 @@ package body Ch4 is
    begin
       if Token = Tok_Abs then
          Node1 := New_Node (N_Op_Abs, Token_Ptr);
-         if Style_Check then Style.Check_Abs_Not; end if;
+
+         if Style_Check then
+            Style.Check_Abs_Not;
+         end if;
+
          Scan; -- past ABS
          Set_Right_Opnd (Node1, P_Primary);
          Set_Op_Name (Node1);
@@ -2015,7 +2065,11 @@ package body Ch4 is
 
       elsif Token = Tok_Not then
          Node1 := New_Node (N_Op_Not, Token_Ptr);
-         if Style_Check then Style.Check_Abs_Not; end if;
+
+         if Style_Check then
+            Style.Check_Abs_Not;
+         end if;
+
          Scan; -- past NOT
          Set_Right_Opnd (Node1, P_Primary);
          Set_Op_Name (Node1);
@@ -2116,7 +2170,18 @@ package body Ch4 is
             --  Left paren, starts aggregate or parenthesized expression
 
             when Tok_Left_Paren =>
-               return P_Aggregate_Or_Paren_Expr;
+               declare
+                  Expr : constant Node_Id := P_Aggregate_Or_Paren_Expr;
+
+               begin
+                  if Nkind (Expr) = N_Attribute_Reference
+                    and then Attribute_Name (Expr) = Name_Range
+                  then
+                     Bad_Range_Attribute (Sloc (Expr));
+                  end if;
+
+                  return Expr;
+               end;
 
             --  Allocator
 
@@ -2174,7 +2239,10 @@ package body Ch4 is
    function P_Logical_Operator return Node_Kind is
    begin
       if Token = Tok_And then
-         if Style_Check then Style.Check_Binary_Operator; end if;
+         if Style_Check then
+            Style.Check_Binary_Operator;
+         end if;
+
          Scan; -- past AND
 
          if Token = Tok_Then then
@@ -2185,7 +2253,10 @@ package body Ch4 is
          end if;
 
       elsif Token = Tok_Or then
-         if Style_Check then Style.Check_Binary_Operator; end if;
+         if Style_Check then
+            Style.Check_Binary_Operator;
+         end if;
+
          Scan; -- past OR
 
          if Token = Tok_Else then
@@ -2196,7 +2267,10 @@ package body Ch4 is
          end if;
 
       else -- Token = Tok_Xor
-         if Style_Check then Style.Check_Binary_Operator; end if;
+         if Style_Check then
+            Style.Check_Binary_Operator;
+         end if;
+
          Scan; -- past XOR
          return N_Op_Xor;
       end if;
@@ -2235,7 +2309,11 @@ package body Ch4 is
       end if;
 
       Op_Kind := Relop_Node (Token);
-      if Style_Check then Style.Check_Binary_Operator; end if;
+
+      if Style_Check then
+         Style.Check_Binary_Operator;
+      end if;
+
       Scan; -- past operator token
 
       if Prev_Token = Tok_Not then

gcc/ada/sem_aggr.adb

@@ -39,11 +39,9 @@ with Namet;    use Namet;
 with Nmake;    use Nmake;
 with Nlists;   use Nlists;
 with Opt;      use Opt;
-with Rtsfind;  use Rtsfind;
 with Sem;      use Sem;
 with Sem_Cat;  use Sem_Cat;
 with Sem_Ch3;  use Sem_Ch3;
-with Sem_Ch8;  use Sem_Ch8;
 with Sem_Ch13; use Sem_Ch13;
 with Sem_Eval; use Sem_Eval;
 with Sem_Res;  use Sem_Res;
@@ -88,7 +86,7 @@ package body Sem_Aggr is
    --  E_Component/E_Discriminant entity in the record case, in which case the
    --  type of the component will be used for the test. If Typ is any other
    --  kind of entity, the call is ignored. Expr is the component node in the
-   --  aggregate which is an explicit occurrence of NULL. An error will be
+   --  aggregate which is known to have a null value. A warning message will be
    --  issued if the component is null excluding.
    --
    --  It would be better to pass the proper type for Typ ???
@@ -639,9 +637,11 @@ package body Sem_Aggr is
             Index_Typ  : Entity_Id;
 
          begin
-            --  Construct the Index subtype
+            --  Construct the Index subtype, and associate it with the range
+            --  construct that generates it.
 
-            Index_Typ := Create_Itype (Subtype_Kind (Ekind (Index_Base)), N);
+            Index_Typ :=
+              Create_Itype (Subtype_Kind (Ekind (Index_Base)), Aggr_Range (J));
 
             Set_Etype (Index_Typ, Index_Base);
 
@@ -684,32 +684,15 @@ package body Sem_Aggr is
       Set_Is_Internal    (Itype, True);
       Init_Size_Align    (Itype);
 
-      --  Handle aggregate initializing statically allocated dispatch table
-
-      if Static_Dispatch_Tables
-        and then VM_Target = No_VM
-        and then RTU_Loaded (Ada_Tags)
-
-         --  Avoid circularity when rebuilding the compiler
-
-        and then Cunit_Entity (Get_Source_Unit (N)) /= RTU_Entity (Ada_Tags)
-        and then (Etype (N) = RTE (RE_Address_Array)
-                    or else
-                  Base_Type (Etype (N)) = RTE (RE_Tag_Table))
-      then
-         Set_Size_Known_At_Compile_Time (Itype);
-
       --  A simple optimization: purely positional aggregates of static
       --  components should be passed to gigi unexpanded whenever possible,
       --  and regardless of the staticness of the bounds themselves. Subse-
       --  quent checks in exp_aggr verify that type is not packed, etc.
 
-      else
-         Set_Size_Known_At_Compile_Time (Itype,
-            Is_Fully_Positional
-              and then Comes_From_Source (N)
-              and then Size_Known_At_Compile_Time (Component_Type (Typ)));
-      end if;
+      Set_Size_Known_At_Compile_Time (Itype,
+         Is_Fully_Positional
+           and then Comes_From_Source (N)
+           and then Size_Known_At_Compile_Time (Component_Type (Typ)));
 
       --  We always need a freeze node for a packed array subtype, so that
       --  we can build the Packed_Array_Type corresponding to the subtype.
@@ -1022,7 +1005,7 @@ package body Sem_Aggr is
                Pkind = N_Procedure_Call_Statement  or else
                Pkind = N_Generic_Association       or else
                Pkind = N_Formal_Object_Declaration or else
-               Pkind = N_Return_Statement          or else
+               Pkind = N_Simple_Return_Statement   or else
                Pkind = N_Object_Declaration        or else
                Pkind = N_Component_Declaration     or else
                Pkind = N_Parameter_Specification   or else
@@ -1719,7 +1702,7 @@ package body Sem_Aggr is
                --  Ada 2005 (AI-231)
 
                if Ada_Version >= Ada_05
-                 and then Nkind (Expression (Assoc)) = N_Null
+                 and then Known_Null (Expression (Assoc))
                then
                   Check_Can_Never_Be_Null (Etype (N), Expression (Assoc));
                end if;
@@ -1851,7 +1834,7 @@ package body Sem_Aggr is
             --  Ada 2005 (AI-231)
 
             if Ada_Version >= Ada_05
-              and then Nkind (Expr) = N_Null
+              and then Known_Null (Expr)
             then
                Check_Can_Never_Be_Null (Etype (N), Expr);
             end if;
@@ -1869,7 +1852,7 @@ package body Sem_Aggr is
             --  Ada 2005 (AI-231)
 
             if Ada_Version >= Ada_05
-              and then Nkind (Assoc) = N_Null
+              and then Known_Null (Assoc)
             then
                Check_Can_Never_Be_Null (Etype (N), Expression (Assoc));
             end if;
@@ -2401,7 +2384,7 @@ package body Sem_Aggr is
                      --  Ada 2005 (AI-231)
 
                      if Ada_Version >= Ada_05
-                       and then Nkind (Expression (Assoc)) = N_Null
+                       and then Known_Null (Expression (Assoc))
                      then
                         Check_Can_Never_Be_Null (Compon, Expression (Assoc));
                      end if;
@@ -2731,7 +2714,7 @@ package body Sem_Aggr is
                --  Ada 2005 (AI-231)
 
                if Ada_Version >= Ada_05
-                 and then Nkind (Positional_Expr) = N_Null
+                 and then Known_Null (Positional_Expr)
                then
                   Check_Can_Never_Be_Null (Discrim, Positional_Expr);
                end if;
@@ -2969,7 +2952,7 @@ package body Sem_Aggr is
          --  Ada 2005 (AI-231)
 
          if Ada_Version >= Ada_05
-           and then Nkind (Positional_Expr) = N_Null
+           and then Known_Null (Positional_Expr)
          then
             Check_Can_Never_Be_Null (Component, Positional_Expr);
          end if;
@@ -3052,7 +3035,7 @@ package body Sem_Aggr is
                   then
                      --  We build a partially initialized aggregate with the
                      --  values of the discriminants and box initialization
-                     --  for the rest.
+                     --  for the rest, if other components are present.
 
                      declare
                         Loc        : constant Source_Ptr := Sloc (N);
@@ -3085,13 +3068,29 @@ package body Sem_Aggr is
                            Next_Elmt (Discr_Elmt);
                         end loop;
 
-                        Append
-                          (Make_Component_Association (Loc,
-                             Choices     =>
-                               New_List (Make_Others_Choice (Loc)),
-                             Expression  => Empty,
-                             Box_Present => True),
-                           Component_Associations (Expr));
+                        declare
+                           Comp : Entity_Id;
+
+                        begin
+                           --  Look for a component that is not a discriminant
+                           --  before creating an others box association.
+
+                           Comp := First_Component (Ctyp);
+                           while Present (Comp) loop
+                              if Ekind (Comp) = E_Component then
+                                 Append
+                                   (Make_Component_Association (Loc,
+                                      Choices     =>
+                                        New_List (Make_Others_Choice (Loc)),
+                                      Expression  => Empty,
+                                      Box_Present => True),
+                                    Component_Associations (Expr));
+                                 exit;
+                              end if;
+
+                              Next_Component (Comp);
+                           end loop;
+                        end;
 
                         Add_Association
                           (Component      => Component,
@@ -3271,7 +3270,7 @@ package body Sem_Aggr is
       pragma Assert
         (Ada_Version >= Ada_05
           and then Present (Expr)
-          and then Nkind (Expr) = N_Null);
+          and then Known_Null (Expr));
 
       case Ekind (Typ) is
          when E_Array_Type  =>
@@ -3295,7 +3294,7 @@ package body Sem_Aggr is
          Insert_Action
            (Compile_Time_Constraint_Error
               (Expr,
-               "(Ada 2005) NULL not allowed in null-excluding components?"),
+               "(Ada 2005) null not allowed in null-excluding component?"),
             Make_Raise_Constraint_Error (Sloc (Expr),
               Reason => CE_Access_Check_Failed));