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 --
-----------------------
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);
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;
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
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;
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);
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;
Node_Count := 0;
Atree_Private_Part.Nodes.Init;
Orig_Nodes.Init;
+ Paren_Counts.Init;
-- Allocate Empty node
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
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;
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;
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
-- 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;
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;
------------
-------------
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.
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;
-- 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;
----------------
Tree_Read_Int (Node_Count);
Nodes.Tree_Read;
Orig_Nodes.Tree_Read;
+ Paren_Counts.Tree_Read;
end Tree_Read;
----------------
Tree_Write_Int (Node_Count);
Nodes.Tree_Write;
Orig_Nodes.Tree_Write;
+ Paren_Counts.Tree_Write;
end Tree_Write;
------------------------------
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;
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;
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;
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
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
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
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
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
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
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
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
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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)
-- 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;
----------------------------------------
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);
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);
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);
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);
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
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);
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);
-- 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
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
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
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;
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
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;
-- 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 ???
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);
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.
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
-- 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;
-- 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;
-- 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;
-- 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;
-- 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;
-- 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;
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);
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,
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 =>
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));
projects / platform / upstream / gcc.git / commitdiff