+2010-09-09 Robert Dewar <dewar@adacore.com>
+
+ * nlists.ads, nlists.adb (In_Same_List): New function.
+ Use Node_Or_Entity_Id where appropriate.
+ * par-labl.adb, sem_ch6.adb, sem_type.adb: Use In_Same_List.
+
+2010-09-09 Robert Dewar <dewar@adacore.com>
+
+ * restrict.ads, restrict.adb (Check_Wide_Character_Restriction): New
+ procedure.
+ * sem_ch3.adb: Use Check_Wide_Character_Restriction
+ (Enumeration_Type_Declaration): Check violation of No_Wide_Characters
+ * sem_ch8.adb (Find_Direct_Name): Check violation of No_Wide_Characters
+ (Find_Expanded_Name): Check violation of No_Wide_Characters
+
+2010-09-09 Robert Dewar <dewar@adacore.com>
+
+ * par-ch5.adb: Minor reformatting.
+
2010-09-09 Robert Dewar <dewar@adacore.com>
* prj-env.adb: Minor code reorganization.
-- --
-- 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- --
-- three fields:
type List_Header is record
- First : Node_Id;
+ First : Node_Or_Entity_Id;
-- Pointer to first node in list. Empty if list is empty
- Last : Node_Id;
+ Last : Node_Or_Entity_Id;
-- Pointer to last node in list. Empty if list is empty
Parent : Node_Id;
-- list and Prev_Node is Empty at the start of a list.
package Next_Node is new Table.Table (
- Table_Component_Type => Node_Id,
- Table_Index_Type => Node_Id'Base,
+ Table_Component_Type => Node_Or_Entity_Id,
+ Table_Index_Type => Node_Or_Entity_Id'Base,
Table_Low_Bound => First_Node_Id,
Table_Initial => Alloc.Orig_Nodes_Initial,
Table_Increment => Alloc.Orig_Nodes_Increment,
Table_Name => "Next_Node");
package Prev_Node is new Table.Table (
- Table_Component_Type => Node_Id,
- Table_Index_Type => Node_Id'Base,
+ Table_Component_Type => Node_Or_Entity_Id,
+ Table_Index_Type => Node_Or_Entity_Id'Base,
Table_Low_Bound => First_Node_Id,
Table_Initial => Alloc.Orig_Nodes_Initial,
Table_Increment => Alloc.Orig_Nodes_Increment,
-- Local Subprograms --
-----------------------
- procedure Set_First (List : List_Id; To : Node_Id);
+ procedure Set_First (List : List_Id; To : Node_Or_Entity_Id);
pragma Inline (Set_First);
-- Sets First field of list header List to reference To
- procedure Set_Last (List : List_Id; To : Node_Id);
+ procedure Set_Last (List : List_Id; To : Node_Or_Entity_Id);
pragma Inline (Set_Last);
-- Sets Last field of list header List to reference To
- procedure Set_List_Link (Node : Node_Id; To : List_Id);
+ procedure Set_List_Link (Node : Node_Or_Entity_Id; To : List_Id);
pragma Inline (Set_List_Link);
-- Sets list link of Node to list header To
- procedure Set_Next (Node : Node_Id; To : Node_Id);
+ procedure Set_Next (Node : Node_Or_Entity_Id; To : Node_Or_Entity_Id);
pragma Inline (Set_Next);
-- Sets the Next_Node pointer for Node to reference To
- procedure Set_Prev (Node : Node_Id; To : Node_Id);
+ procedure Set_Prev (Node : Node_Or_Entity_Id; To : Node_Or_Entity_Id);
pragma Inline (Set_Prev);
-- Sets the Prev_Node pointer for Node to reference To
-- Allocate_List_Tables --
--------------------------
- procedure Allocate_List_Tables (N : Node_Id) is
- Old_Last : constant Node_Id'Base := Next_Node.Last;
+ procedure Allocate_List_Tables (N : Node_Or_Entity_Id) is
+ Old_Last : constant Node_Or_Entity_Id'Base := Next_Node.Last;
begin
pragma Assert (N >= Old_Last);
-- Append --
------------
- procedure Append (Node : Node_Id; To : List_Id) is
- L : constant Node_Id := Last (To);
+ procedure Append (Node : Node_Or_Entity_Id; To : List_Id) is
+ L : constant Node_Or_Entity_Id := Last (To);
procedure Append_Debug;
pragma Inline (Append_Debug);
else
declare
- L : constant Node_Id := Last (To);
- F : constant Node_Id := First (List);
- N : Node_Id;
+ L : constant Node_Or_Entity_Id := Last (To);
+ F : constant Node_Or_Entity_Id := First (List);
+ N : Node_Or_Entity_Id;
begin
pragma Debug (Append_List_Debug);
-- Append_To --
---------------
- procedure Append_To (To : List_Id; Node : Node_Id) is
+ procedure Append_To (To : List_Id; Node : Node_Or_Entity_Id) is
begin
Append (Node, To);
end Append_To;
-- First --
-----------
- function First (List : List_Id) return Node_Id is
+ function First (List : List_Id) return Node_Or_Entity_Id is
begin
if List = No_List then
return Empty;
-- First_Non_Pragma --
----------------------
- function First_Non_Pragma (List : List_Id) return Node_Id is
- N : constant Node_Id := First (List);
+ function First_Non_Pragma (List : List_Id) return Node_Or_Entity_Id is
+ N : constant Node_Or_Entity_Id := First (List);
begin
if Nkind (N) /= N_Pragma
and then
end Initialize;
------------------
- -- Insert_After --
+ -- In_Same_List --
------------------
- procedure Insert_After (After : Node_Id; Node : Node_Id) is
+ function In_Same_List (N1, N2 : Node_Or_Entity_Id) return Boolean is
+ begin
+ return List_Containing (N1) = List_Containing (N2);
+ end In_Same_List;
+ ------------------
+ -- Insert_After --
+ ------------------
+
+ procedure Insert_After
+ (After : Node_Or_Entity_Id;
+ Node : Node_Or_Entity_Id)
+ is
procedure Insert_After_Debug;
pragma Inline (Insert_After_Debug);
-- Output debug information if Debug_Flag_N set
pragma Debug (Insert_After_Debug);
declare
- Before : constant Node_Id := Next (After);
- LC : constant List_Id := List_Containing (After);
+ Before : constant Node_Or_Entity_Id := Next (After);
+ LC : constant List_Id := List_Containing (After);
begin
if Present (Before) then
-- Insert_Before --
-------------------
- procedure Insert_Before (Before : Node_Id; Node : Node_Id) is
-
+ procedure Insert_Before
+ (Before : Node_Or_Entity_Id;
+ Node : Node_Or_Entity_Id)
+ is
procedure Insert_Before_Debug;
pragma Inline (Insert_Before_Debug);
-- Output debug information if Debug_Flag_N set
pragma Debug (Insert_Before_Debug);
declare
- After : constant Node_Id := Prev (Before);
- LC : constant List_Id := List_Containing (Before);
+ After : constant Node_Or_Entity_Id := Prev (Before);
+ LC : constant List_Id := List_Containing (Before);
begin
if Present (After) then
-- Insert_List_After --
-----------------------
- procedure Insert_List_After (After : Node_Id; List : List_Id) is
+ procedure Insert_List_After (After : Node_Or_Entity_Id; List : List_Id) is
procedure Insert_List_After_Debug;
pragma Inline (Insert_List_After_Debug);
else
declare
- Before : constant Node_Id := Next (After);
- LC : constant List_Id := List_Containing (After);
- F : constant Node_Id := First (List);
- L : constant Node_Id := Last (List);
- N : Node_Id;
+ Before : constant Node_Or_Entity_Id := Next (After);
+ LC : constant List_Id := List_Containing (After);
+ F : constant Node_Or_Entity_Id := First (List);
+ L : constant Node_Or_Entity_Id := Last (List);
+ N : Node_Or_Entity_Id;
begin
pragma Debug (Insert_List_After_Debug);
-- Insert_List_Before --
------------------------
- procedure Insert_List_Before (Before : Node_Id; List : List_Id) is
+ procedure Insert_List_Before (Before : Node_Or_Entity_Id; List : List_Id) is
procedure Insert_List_Before_Debug;
pragma Inline (Insert_List_Before_Debug);
else
declare
- After : constant Node_Id := Prev (Before);
- LC : constant List_Id := List_Containing (Before);
- F : constant Node_Id := First (List);
- L : constant Node_Id := Last (List);
- N : Node_Id;
+ After : constant Node_Or_Entity_Id := Prev (Before);
+ LC : constant List_Id := List_Containing (Before);
+ F : constant Node_Or_Entity_Id := First (List);
+ L : constant Node_Or_Entity_Id := Last (List);
+ N : Node_Or_Entity_Id;
begin
pragma Debug (Insert_List_Before_Debug);
-- Is_List_Member --
--------------------
- function Is_List_Member (Node : Node_Id) return Boolean is
+ function Is_List_Member (Node : Node_Or_Entity_Id) return Boolean is
begin
return Nodes.Table (Node).In_List;
end Is_List_Member;
-- Last --
----------
- function Last (List : List_Id) return Node_Id is
+ function Last (List : List_Id) return Node_Or_Entity_Id is
begin
pragma Assert (List <= Lists.Last);
return Lists.Table (List).Last;
-- Last_Non_Pragma --
---------------------
- function Last_Non_Pragma (List : List_Id) return Node_Id is
- N : constant Node_Id := Last (List);
+ function Last_Non_Pragma (List : List_Id) return Node_Or_Entity_Id is
+ N : constant Node_Or_Entity_Id := Last (List);
begin
if Nkind (N) /= N_Pragma then
return N;
-- List_Containing --
---------------------
- function List_Containing (Node : Node_Id) return List_Id is
+ function List_Containing (Node : Node_Or_Entity_Id) return List_Id is
begin
pragma Assert (Is_List_Member (Node));
return List_Id (Nodes.Table (Node).Link);
function List_Length (List : List_Id) return Nat is
Result : Nat;
- Node : Node_Id;
+ Node : Node_Or_Entity_Id;
begin
Result := 0;
function New_Copy_List (List : List_Id) return List_Id is
NL : List_Id;
- E : Node_Id;
+ E : Node_Or_Entity_Id;
begin
if List = No_List then
function New_Copy_List_Original (List : List_Id) return List_Id is
NL : List_Id;
- E : Node_Id;
+ E : Node_Or_Entity_Id;
begin
if List = No_List then
-- list directly, rather than first building an empty list and then doing
-- the insertion, which results in some unnecessary work.
- function New_List (Node : Node_Id) return List_Id is
+ function New_List (Node : Node_Or_Entity_Id) return List_Id is
procedure New_List_Debug;
pragma Inline (New_List_Debug);
end if;
end New_List;
- function New_List (Node1, Node2 : Node_Id) return List_Id is
+ function New_List
+ (Node1 : Node_Or_Entity_Id;
+ Node2 : Node_Or_Entity_Id) return List_Id
+ is
L : constant List_Id := New_List (Node1);
begin
Append (Node2, L);
return L;
end New_List;
- function New_List (Node1, Node2, Node3 : Node_Id) return List_Id is
+ function New_List
+ (Node1 : Node_Or_Entity_Id;
+ Node2 : Node_Or_Entity_Id;
+ Node3 : Node_Or_Entity_Id) return List_Id
+ is
L : constant List_Id := New_List (Node1);
begin
Append (Node2, L);
return L;
end New_List;
- function New_List (Node1, Node2, Node3, Node4 : Node_Id) return List_Id is
+ function New_List
+ (Node1 : Node_Or_Entity_Id;
+ Node2 : Node_Or_Entity_Id;
+ Node3 : Node_Or_Entity_Id;
+ Node4 : Node_Or_Entity_Id) return List_Id
+ is
L : constant List_Id := New_List (Node1);
begin
Append (Node2, L);
end New_List;
function New_List
- (Node1 : Node_Id;
- Node2 : Node_Id;
- Node3 : Node_Id;
- Node4 : Node_Id;
- Node5 : Node_Id) return List_Id
+ (Node1 : Node_Or_Entity_Id;
+ Node2 : Node_Or_Entity_Id;
+ Node3 : Node_Or_Entity_Id;
+ Node4 : Node_Or_Entity_Id;
+ Node5 : Node_Or_Entity_Id) return List_Id
is
L : constant List_Id := New_List (Node1);
begin
end New_List;
function New_List
- (Node1 : Node_Id;
- Node2 : Node_Id;
- Node3 : Node_Id;
- Node4 : Node_Id;
- Node5 : Node_Id;
- Node6 : Node_Id) return List_Id
+ (Node1 : Node_Or_Entity_Id;
+ Node2 : Node_Or_Entity_Id;
+ Node3 : Node_Or_Entity_Id;
+ Node4 : Node_Or_Entity_Id;
+ Node5 : Node_Or_Entity_Id;
+ Node6 : Node_Or_Entity_Id) return List_Id
is
L : constant List_Id := New_List (Node1);
begin
-- Next --
----------
- function Next (Node : Node_Id) return Node_Id is
+ function Next (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id is
begin
pragma Assert (Is_List_Member (Node));
return Next_Node.Table (Node);
end Next;
- procedure Next (Node : in out Node_Id) is
+ procedure Next (Node : in out Node_Or_Entity_Id) is
begin
Node := Next (Node);
end Next;
-- Next_Non_Pragma --
---------------------
- function Next_Non_Pragma (Node : Node_Id) return Node_Id is
- N : Node_Id;
+ function Next_Non_Pragma
+ (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id
+ is
+ N : Node_Or_Entity_Id;
begin
N := Node;
loop
N := Next (N);
- exit when Nkind (N) /= N_Pragma
- and then
- Nkind (N) /= N_Null_Statement;
+ exit when not Nkind_In (N, N_Pragma, N_Null_Statement);
end loop;
return N;
end Next_Non_Pragma;
- procedure Next_Non_Pragma (Node : in out Node_Id) is
+ procedure Next_Non_Pragma (Node : in out Node_Or_Entity_Id) is
begin
Node := Next_Non_Pragma (Node);
end Next_Non_Pragma;
-- p --
-------
- function p (U : Union_Id) return Node_Id is
+ function p (U : Union_Id) return Node_Or_Entity_Id is
begin
if U in Node_Range then
- return Parent (Node_Id (U));
+ return Parent (Node_Or_Entity_Id (U));
elsif U in List_Range then
return Parent (List_Id (U));
else
-- Parent --
------------
- function Parent (List : List_Id) return Node_Id is
+ function Parent (List : List_Id) return Node_Or_Entity_Id is
begin
pragma Assert (List <= Lists.Last);
return Lists.Table (List).Parent;
-- Pick --
----------
- function Pick (List : List_Id; Index : Pos) return Node_Id is
- Elmt : Node_Id;
+ function Pick (List : List_Id; Index : Pos) return Node_Or_Entity_Id is
+ Elmt : Node_Or_Entity_Id;
begin
Elmt := First (List);
-- Prepend --
-------------
- procedure Prepend (Node : Node_Id; To : List_Id) is
- F : constant Node_Id := First (To);
+ procedure Prepend (Node : Node_Or_Entity_Id; To : List_Id) is
+ F : constant Node_Or_Entity_Id := First (To);
procedure Prepend_Debug;
pragma Inline (Prepend_Debug);
else
declare
- F : constant Node_Id := First (To);
- L : constant Node_Id := Last (List);
- N : Node_Id;
+ F : constant Node_Or_Entity_Id := First (To);
+ L : constant Node_Or_Entity_Id := Last (List);
+ N : Node_Or_Entity_Id;
begin
pragma Debug (Prepend_List_Debug);
-- Prepend_To --
----------------
- procedure Prepend_To (To : List_Id; Node : Node_Id) is
+ procedure Prepend_To (To : List_Id; Node : Node_Or_Entity_Id) is
begin
Prepend (Node, To);
end Prepend_To;
-- Prev --
----------
- function Prev (Node : Node_Id) return Node_Id is
+ function Prev (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id is
begin
pragma Assert (Is_List_Member (Node));
return Prev_Node.Table (Node);
end Prev;
- procedure Prev (Node : in out Node_Id) is
+ procedure Prev (Node : in out Node_Or_Entity_Id) is
begin
Node := Prev (Node);
end Prev;
-- Prev_Non_Pragma --
---------------------
- function Prev_Non_Pragma (Node : Node_Id) return Node_Id is
- N : Node_Id;
+ function Prev_Non_Pragma
+ (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id
+ is
+ N : Node_Or_Entity_Id;
begin
N := Node;
return N;
end Prev_Non_Pragma;
- procedure Prev_Non_Pragma (Node : in out Node_Id) is
+ procedure Prev_Non_Pragma (Node : in out Node_Or_Entity_Id) is
begin
Node := Prev_Non_Pragma (Node);
end Prev_Non_Pragma;
-- Remove --
------------
- procedure Remove (Node : Node_Id) is
- Lst : constant List_Id := List_Containing (Node);
- Prv : constant Node_Id := Prev (Node);
- Nxt : constant Node_Id := Next (Node);
+ procedure Remove (Node : Node_Or_Entity_Id) is
+ Lst : constant List_Id := List_Containing (Node);
+ Prv : constant Node_Or_Entity_Id := Prev (Node);
+ Nxt : constant Node_Or_Entity_Id := Next (Node);
procedure Remove_Debug;
pragma Inline (Remove_Debug);
-- Remove_Head --
-----------------
- function Remove_Head (List : List_Id) return Node_Id is
- Frst : constant Node_Id := First (List);
+ function Remove_Head (List : List_Id) return Node_Or_Entity_Id is
+ Frst : constant Node_Or_Entity_Id := First (List);
procedure Remove_Head_Debug;
pragma Inline (Remove_Head_Debug);
else
declare
- Nxt : constant Node_Id := Next (Frst);
+ Nxt : constant Node_Or_Entity_Id := Next (Frst);
begin
Set_First (List, Nxt);
-- Remove_Next --
-----------------
- function Remove_Next (Node : Node_Id) return Node_Id is
- Nxt : constant Node_Id := Next (Node);
+ function Remove_Next
+ (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id
+ is
+ Nxt : constant Node_Or_Entity_Id := Next (Node);
procedure Remove_Next_Debug;
pragma Inline (Remove_Next_Debug);
begin
if Present (Nxt) then
declare
- Nxt2 : constant Node_Id := Next (Nxt);
- LC : constant List_Id := List_Containing (Node);
+ Nxt2 : constant Node_Or_Entity_Id := Next (Nxt);
+ LC : constant List_Id := List_Containing (Node);
begin
pragma Debug (Remove_Next_Debug);
-- Set_First --
---------------
- procedure Set_First (List : List_Id; To : Node_Id) is
+ procedure Set_First (List : List_Id; To : Node_Or_Entity_Id) is
begin
Lists.Table (List).First := To;
end Set_First;
-- Set_Last --
--------------
- procedure Set_Last (List : List_Id; To : Node_Id) is
+ procedure Set_Last (List : List_Id; To : Node_Or_Entity_Id) is
begin
Lists.Table (List).Last := To;
end Set_Last;
-- Set_List_Link --
-------------------
- procedure Set_List_Link (Node : Node_Id; To : List_Id) is
+ procedure Set_List_Link (Node : Node_Or_Entity_Id; To : List_Id) is
begin
Nodes.Table (Node).Link := Union_Id (To);
end Set_List_Link;
-- Set_Next --
--------------
- procedure Set_Next (Node : Node_Id; To : Node_Id) is
+ procedure Set_Next (Node : Node_Or_Entity_Id; To : Node_Or_Entity_Id) is
begin
Next_Node.Table (Node) := To;
end Set_Next;
-- Set_Parent --
----------------
- procedure Set_Parent (List : List_Id; Node : Node_Id) is
+ procedure Set_Parent (List : List_Id; Node : Node_Or_Entity_Id) is
begin
pragma Assert (List <= Lists.Last);
Lists.Table (List).Parent := Node;
-- Set_Prev --
--------------
- procedure Set_Prev (Node : Node_Id; To : Node_Id) is
+ procedure Set_Prev (Node : Node_Or_Entity_Id; To : Node_Or_Entity_Id) is
begin
Prev_Node.Table (Node) := To;
end Set_Prev;
-- --
-- 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- --
-- Note: node lists can contain either nodes or entities (extended nodes)
-- or a mixture of nodes and extended nodes.
+ function In_Same_List (N1, N2 : Node_Or_Entity_Id) return Boolean;
+ pragma Inline (In_Same_List);
+ -- Equivalent to List_Containing (N1) = List_Containing (N2)
+
function Last_List_Id return List_Id;
pragma Inline (Last_List_Id);
-- Returns Id of last allocated list header
-- Used in contexts where an empty list (as opposed to an initially empty
-- list to be filled in) is required.
- function New_List (Node : Node_Id) return List_Id;
+ function New_List
+ (Node : Node_Or_Entity_Id) return List_Id;
-- Build a new list initially containing the given node
- function New_List (Node1, Node2 : Node_Id) return List_Id;
+ function New_List
+ (Node1 : Node_Or_Entity_Id;
+ Node2 : Node_Or_Entity_Id) return List_Id;
-- Build a new list initially containing the two given nodes
- function New_List (Node1, Node2, Node3 : Node_Id) return List_Id;
+ function New_List
+ (Node1 : Node_Or_Entity_Id;
+ Node2 : Node_Or_Entity_Id;
+ Node3 : Node_Or_Entity_Id) return List_Id;
-- Build a new list initially containing the three given nodes
- function New_List (Node1, Node2, Node3, Node4 : Node_Id) return List_Id;
- -- Build a new list initially containing the four given nodes
+ function New_List
+ (Node1 : Node_Or_Entity_Id;
+ Node2 : Node_Or_Entity_Id;
+ Node3 : Node_Or_Entity_Id;
+ Node4 : Node_Or_Entity_Id) return List_Id;
function New_List
- (Node1 : Node_Id;
- Node2 : Node_Id;
- Node3 : Node_Id;
- Node4 : Node_Id;
- Node5 : Node_Id) return List_Id;
+ (Node1 : Node_Or_Entity_Id;
+ Node2 : Node_Or_Entity_Id;
+ Node3 : Node_Or_Entity_Id;
+ Node4 : Node_Or_Entity_Id;
+ Node5 : Node_Or_Entity_Id) return List_Id;
-- Build a new list initially containing the five given nodes
function New_List
- (Node1 : Node_Id;
- Node2 : Node_Id;
- Node3 : Node_Id;
- Node4 : Node_Id;
- Node5 : Node_Id;
- Node6 : Node_Id) return List_Id;
+ (Node1 : Node_Or_Entity_Id;
+ Node2 : Node_Or_Entity_Id;
+ Node3 : Node_Or_Entity_Id;
+ Node4 : Node_Or_Entity_Id;
+ Node5 : Node_Or_Entity_Id;
+ Node6 : Node_Or_Entity_Id) return List_Id;
-- Build a new list initially containing the six given nodes
function New_Copy_List (List : List_Id) return List_Id;
function New_Copy_List_Original (List : List_Id) return List_Id;
-- Same as New_Copy_List but copies only nodes coming from source
- function First (List : List_Id) return Node_Id;
+ function First (List : List_Id) return Node_Or_Entity_Id;
pragma Inline (First);
-- Obtains the first element of the given node list or, if the node list
-- has no items or is equal to No_List, then Empty is returned.
- function First_Non_Pragma (List : List_Id) return Node_Id;
+ function First_Non_Pragma (List : List_Id) return Node_Or_Entity_Id;
-- Used when dealing with a list that can contain pragmas to skip past
-- any initial pragmas and return the first element that is not a pragma.
-- If the list is empty, or if it contains only pragmas, then Empty is
-- This function also skips N_Null nodes which can result from rewriting
-- unrecognized or incorrect pragmas.
- function Last (List : List_Id) return Node_Id;
+ function Last (List : List_Id) return Node_Or_Entity_Id;
pragma Inline (Last);
-- Obtains the last element of the given node list or, if the node list
-- has no items, then Empty is returned. It is an error to call Last with
-- a Node_Id or No_List. (No_List is not considered to be the same as an
-- empty node list).
- function Last_Non_Pragma (List : List_Id) return Node_Id;
+ function Last_Non_Pragma (List : List_Id) return Node_Or_Entity_Id;
-- Obtains the last element of a given node list that is not a pragma.
-- If the list is empty, or if it contains only pragmas, then Empty is
-- returned. It is an error to call Last_Non_Pragma with a Node_Id or
-- this function with No_List (No_List is not considered to be the same
-- as an empty list).
- function Next (Node : Node_Id) return Node_Id;
+ function Next (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id;
pragma Inline (Next);
-- This function returns the next node on a node list, or Empty if Node is
-- the last element of the node list. The argument must be a member of a
-- node list.
- procedure Next (Node : in out Node_Id);
+ procedure Next (Node : in out Node_Or_Entity_Id);
pragma Inline (Next);
-- Equivalent to Node := Next (Node);
- function Next_Non_Pragma (Node : Node_Id) return Node_Id;
+ function Next_Non_Pragma
+ (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id;
-- This function returns the next node on a node list, skipping past any
-- pragmas, or Empty if there is no non-pragma entry left. The argument
-- must be a member of a node list. This function also skips N_Null nodes
-- which can result from rewriting unrecognized or incorrect pragmas.
- procedure Next_Non_Pragma (Node : in out Node_Id);
+ procedure Next_Non_Pragma (Node : in out Node_Or_Entity_Id);
pragma Inline (Next_Non_Pragma);
-- Equivalent to Node := Next_Non_Pragma (Node);
- function Prev (Node : Node_Id) return Node_Id;
+ function Prev (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id;
pragma Inline (Prev);
-- This function returns the previous node on a node list, or Empty
-- if Node is the first element of the node list. The argument must be
-- a member of a node list. Note: the implementation does maintain back
-- pointers, so this function executes quickly in constant time.
- function Pick (List : List_Id; Index : Pos) return Node_Id;
+ function Pick (List : List_Id; Index : Pos) return Node_Or_Entity_Id;
-- Given a list, picks out the Index'th entry (1 = first entry). The
-- caller must ensure that Index is in range.
- procedure Prev (Node : in out Node_Id);
+ procedure Prev (Node : in out Node_Or_Entity_Id);
pragma Inline (Prev);
-- Equivalent to Node := Prev (Node);
- function Prev_Non_Pragma (Node : Node_Id) return Node_Id;
+ function Prev_Non_Pragma
+ (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id;
pragma Inline (Prev_Non_Pragma);
-- This function returns the previous node on a node list, skipping any
-- pragmas. If Node is the first element of the list, or if the only
-- does maintain back pointers, so this function executes quickly in
-- constant time.
- procedure Prev_Non_Pragma (Node : in out Node_Id);
+ procedure Prev_Non_Pragma (Node : in out Node_Or_Entity_Id);
pragma Inline (Prev_Non_Pragma);
-- Equivalent to Node := Prev_Non_Pragma (Node);
-- This function determines if a given list id references a node list that
-- contains at least one item. No_List as an argument returns False.
- function Is_List_Member (Node : Node_Id) return Boolean;
+ function Is_List_Member (Node : Node_Or_Entity_Id) return Boolean;
pragma Inline (Is_List_Member);
-- This function determines if a given node is a member of a node list.
-- It is an error for Node to be Empty, or to be a node list.
- function List_Containing (Node : Node_Id) return List_Id;
+ function List_Containing (Node : Node_Or_Entity_Id) return List_Id;
pragma Inline (List_Containing);
-- This function provides a pointer to the node list containing Node.
-- Node must be a member of a node list.
- procedure Append (Node : Node_Id; To : List_Id);
+ procedure Append (Node : Node_Or_Entity_Id; To : List_Id);
-- Appends Node at the end of node list To. Node must be a non-empty node
-- that is not already a member of a node list, and To must be a
-- node list. An attempt to append an error node is ignored without
-- complaint and the list is unchanged.
- procedure Append_To (To : List_Id; Node : Node_Id);
+ procedure Append_To (To : List_Id; Node : Node_Or_Entity_Id);
pragma Inline (Append_To);
-- Like Append, but arguments are the other way round
pragma Inline (Append_List_To);
-- Like Append_List, but arguments are the other way round
- procedure Insert_After (After : Node_Id; Node : Node_Id);
+ procedure Insert_After
+ (After : Node_Or_Entity_Id;
+ Node : Node_Or_Entity_Id);
-- Insert Node, which must be a non-empty node that is not already a
-- member of a node list, immediately past node After, which must be a
-- node that is currently a member of a node list. An attempt to insert
-- an error node is ignored without complaint (and the list is unchanged).
- procedure Insert_List_After (After : Node_Id; List : List_Id);
+ procedure Insert_List_After
+ (After : Node_Or_Entity_Id;
+ List : List_Id);
-- Inserts the entire contents of node list List immediately after node
-- After, which must be a member of a node list. On return, the node list
-- List is reset to be the empty node list.
- procedure Insert_Before (Before : Node_Id; Node : Node_Id);
+ procedure Insert_Before
+ (Before : Node_Or_Entity_Id;
+ Node : Node_Or_Entity_Id);
-- Insert Node, which must be a non-empty node that is not already a
-- member of a node list, immediately before Before, which must be a node
-- that is currently a member of a node list. An attempt to insert an
-- error node is ignored without complaint (and the list is unchanged).
- procedure Insert_List_Before (Before : Node_Id; List : List_Id);
+ procedure Insert_List_Before
+ (Before : Node_Or_Entity_Id;
+ List : List_Id);
-- Inserts the entire contents of node list List immediately before node
-- Before, which must be a member of a node list. On return, the node list
-- List is reset to be the empty node list.
- procedure Prepend (Node : Node_Id; To : List_Id);
+ procedure Prepend
+ (Node : Node_Or_Entity_Id;
+ To : List_Id);
-- Prepends Node at the start of node list To. Node must be a non-empty
-- node that is not already a member of a node list, and To must be a
-- node list. An attempt to prepend an error node is ignored without
-- complaint and the list is unchanged.
- procedure Prepend_To (To : List_Id; Node : Node_Id);
+ procedure Prepend_To
+ (To : List_Id;
+ Node : Node_Or_Entity_Id);
pragma Inline (Prepend_To);
-- Like Prepend, but arguments are the other way round
- procedure Prepend_List (List : List_Id; To : List_Id);
+ procedure Prepend_List
+ (List : List_Id;
+ To : List_Id);
-- Prepends node list List to the start of node list To. On return,
-- List is reset to be empty.
- procedure Prepend_List_To (To : List_Id; List : List_Id);
+ procedure Prepend_List_To
+ (To : List_Id;
+ List : List_Id);
pragma Inline (Prepend_List_To);
-- Like Prepend_List, but arguments are the other way round
- procedure Remove (Node : Node_Id);
+ procedure Remove (Node : Node_Or_Entity_Id);
-- Removes Node, which must be a node that is a member of a node list,
-- from this node list. The contents of Node are not otherwise affected.
- function Remove_Head (List : List_Id) return Node_Id;
+ function Remove_Head (List : List_Id) return Node_Or_Entity_Id;
-- Removes the head element of a node list, and returns the node (whose
-- contents are not otherwise affected) as the result. If the node list
-- is empty, then Empty is returned.
- function Remove_Next (Node : Node_Id) return Node_Id;
+ function Remove_Next (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id;
-- Removes the item immediately following the given node, and returns it
-- as the result. If Node is the last element of the list, then Empty is
-- returned. Node must be a member of a list. Unlike Remove, Remove_Next
-- Writes out internal tables to current tree file using the relevant
-- Table.Tree_Write routines.
- function Parent (List : List_Id) return Node_Id;
+ function Parent (List : List_Id) return Node_Or_Entity_Id;
pragma Inline (Parent);
-- Node lists may have a parent in the same way as a node. The function
-- accesses the Parent value, which is either Empty when a list header
-- is first created, or the value that has been set by Set_Parent.
- procedure Set_Parent (List : List_Id; Node : Node_Id);
+ procedure Set_Parent (List : List_Id; Node : Node_Or_Entity_Id);
pragma Inline (Set_Parent);
-- Sets the parent field of the given list to reference the given node
-- Tests given Id for inequality with No_List. This allows notations like
-- "if Present (Statements)" as opposed to "if Statements /= No_List".
- procedure Allocate_List_Tables (N : Node_Id);
+ procedure Allocate_List_Tables (N : Node_Or_Entity_Id);
-- Called when nodes table is expanded to include node N. This call
-- makes sure that list structures internal to Nlists are adjusted
-- appropriately to reflect this increase in the size of the nodes table.
-- These functions return the addresses of the Next_Node and Prev_Node
-- tables (used in Back_End for Gigi).
- function p (U : Union_Id) return Node_Id;
+ function p (U : Union_Id) return Node_Or_Entity_Id;
-- This function is intended for use from the debugger, it determines
-- whether U is a Node_Id or List_Id, and calls the appropriate Parent
-- function and returns the parent Node in either case. This is shorter
when Tok_Exception =>
Test_Statement_Required;
- -- If Extm not set and the exception is not to the left
- -- of the expected column of the end for this sequence, then
- -- we assume it belongs to the current sequence, even though
- -- it is not permitted.
+ -- If Extm not set and the exception is not to the left of
+ -- the expected column of the end for this sequence, then we
+ -- assume it belongs to the current sequence, even though it
+ -- is not permitted.
if not SS_Flags.Extm and then
Start_Column >= Scope.Table (Scope.Last).Ecol
-- Always return, in the case where we scanned out handlers
-- that we did not expect, Parse_Exception_Handlers returned
- -- with Token being either end or EOF, so we are OK
+ -- with Token being either end or EOF, so we are OK.
exit;
when Tok_Or =>
- -- Terminate if Ortm set or if the or is to the left
- -- of the expected column of the end for this sequence
+ -- Terminate if Ortm set or if the or is to the left of the
+ -- expected column of the end for this sequence.
if SS_Flags.Ortm
or else Start_Column < Scope.Table (Scope.Last).Ecol
exit when SS_Flags.Tatm and then Token = Tok_Abort;
- -- Otherwise we treat THEN as some kind of mess where we
- -- did not see the associated IF, but we pick up assuming
- -- it had been there!
+ -- Otherwise we treat THEN as some kind of mess where we did
+ -- not see the associated IF, but we pick up assuming it had
+ -- been there!
Restore_Scan_State (Scan_State); -- to THEN
Append_To (Statement_List, P_If_Statement);
when Tok_When | Tok_Others =>
- -- Terminate if Whtm set or if the WHEN is to the left
- -- of the expected column of the end for this sequence
+ -- Terminate if Whtm set or if the WHEN is to the left of
+ -- the expected column of the end for this sequence.
if SS_Flags.Whtm
or else Start_Column < Scope.Table (Scope.Last).Ecol
-- If the label and the goto are both in the same statement
-- list, then we've found a loop. Note that labels and goto
- -- statements are always part of some list, so
- -- List_Containing always makes sense.
+ -- statements are always part of some list, so In_Same_List
+ -- always makes sense.
- if List_Containing (Node (N)) =
- List_Containing (Node (S1))
- then
+ if In_Same_List (Node (N), Node (S1)) then
Source := S1;
Found := True;
with Atree; use Atree;
with Casing; use Casing;
+with Einfo; use Einfo;
with Errout; use Errout;
with Debug; use Debug;
with Fname; use Fname;
end loop;
end Check_Restriction_No_Dependence;
+ --------------------------------------
+ -- Check_Wide_Character_Restriction --
+ --------------------------------------
+
+ procedure Check_Wide_Character_Restriction (E : Entity_Id; N : Node_Id) is
+ begin
+ if Restriction_Active (No_Wide_Characters)
+ and then Comes_From_Source (N)
+ then
+ declare
+ T : constant Entity_Id := Root_Type (E);
+ begin
+ if T = Standard_Wide_Character or else
+ T = Standard_Wide_String or else
+ T = Standard_Wide_Wide_Character or else
+ T = Standard_Wide_Wide_String
+ then
+ Check_Restriction (No_Wide_Characters, N);
+ end if;
+ end;
+ end if;
+ end Check_Wide_Character_Restriction;
+
----------------------------------------
-- Cunit_Boolean_Restrictions_Restore --
----------------------------------------
-- mechanism (e.g. a special pragma) to handle this case, but there are
-- only six cases, and it is not worth the effort to do something general.
+ procedure Check_Wide_Character_Restriction (E : Entity_Id; N : Node_Id);
+ -- This procedure checks if the No_Wide_Character restriction is active,
+ -- and if so, if N Comes_From_Source, and the root type of E is one of
+ -- [Wide_]Wide_Character or [Wide_]Wide_String, then the restriction
+ -- violation is recorded, and an appropriate message given.
+
function Cunit_Boolean_Restrictions_Save
return Save_Cunit_Boolean_Restrictions;
-- This function saves the compilation unit restriction settings, and
-- Check No_Wide_Characters restriction
- if T = Standard_Wide_Character
- or else T = Standard_Wide_Wide_Character
- or else Root_Type (T) = Standard_Wide_String
- or else Root_Type (T) = Standard_Wide_Wide_String
- then
- Check_Restriction (No_Wide_Characters, Object_Definition (N));
- end if;
+ Check_Wide_Character_Restriction (T, Object_Definition (N));
-- Indicate this is not set in source. Certainly true for constants,
-- and true for variables so far (will be reset for a variable if and
Generate_Definition (L);
Set_Convention (L, Convention_Intrinsic);
+ -- Case of character literal
+
if Nkind (L) = N_Defining_Character_Literal then
Set_Is_Character_Type (T, True);
+
+ -- Check violation of No_Wide_Characters
+
+ if Restriction_Active (No_Wide_Characters) then
+ Get_Name_String (Chars (L));
+
+ if Name_Len >= 3 and then Name_Buffer (1 .. 2) = "QW" then
+ Check_Restriction (No_Wide_Characters, L);
+ end if;
+ end if;
end if;
Ev := Ev + 1;
-- Check No_Wide_Characters restriction
- if Typ = Standard_Wide_Character
- or else Typ = Standard_Wide_Wide_Character
- or else Typ = Standard_Wide_String
- or else Typ = Standard_Wide_Wide_String
- then
- Check_Restriction (No_Wide_Characters, S);
- end if;
+ Check_Wide_Character_Restriction (Typ, S);
return Typ;
end Find_Type_Of_Subtype_Indic;
if Present (Prag) then
if Present (Spec_Id) then
- if List_Containing (N) =
- List_Containing (Unit_Declaration_Node (Spec_Id))
- then
+ if In_Same_List (N, Unit_Declaration_Node (Spec_Id)) then
Analyze (Prag);
end if;
declare
Subp : constant Entity_Id :=
- Make_Defining_Identifier (Loc, Chars (Body_Id));
+ Make_Defining_Identifier (Loc, Chars (Body_Id));
Decl : constant Node_Id :=
- Make_Subprogram_Declaration (Loc,
- Specification => New_Copy_Tree (Specification (N)));
+ Make_Subprogram_Declaration (Loc,
+ Specification =>
+ New_Copy_Tree (Specification (N)));
+
begin
Set_Defining_Unit_Name (Specification (Decl), Subp);
("equality operator must be declared "
& "before type& is frozen", S, Typ);
- elsif List_Containing (Parent (Typ))
- /=
- List_Containing (Decl)
+ elsif not In_Same_List (Parent (Typ), Decl)
and then not Is_Limited_Type (Typ)
then
Error_Msg_N
-- private with on E.
procedure Find_Expanded_Name (N : Node_Id);
- -- Selected component is known to be expanded name. Verify legality of
- -- selector given the scope denoted by prefix.
+ -- The input is a selected component is known to be expanded name. Verify
+ -- legality of selector given the scope denoted by prefix, and change node
+ -- N into a expanded name with a properly set Entity field.
function Find_Renamed_Entity
(N : Node_Id;
<<Found>> begin
+ -- Check violation of No_Wide_Characters restriction
+
+ Check_Wide_Character_Restriction (E, N);
+
-- When distribution features are available (Get_PCS_Name /=
-- Name_No_DSA), a remote access-to-subprogram type is converted
-- into a record type holding whatever information is needed to
Set_Etype (N, Get_Full_View (Etype (Id)));
end if;
+ -- Check for violation of No_Wide_Characters
+
+ Check_Wide_Character_Restriction (Id, N);
+
-- If the Ekind of the entity is Void, it means that all homonyms are
-- hidden from all visibility (RM 8.3(5,14-20)).
and then Scope (Id) /= Scope (Prev)
and then Used_As_Generic_Actual (Scope (Prev))
and then Used_As_Generic_Actual (Scope (Id))
- and then List_Containing (Current_Use_Clause (Scope (Prev))) /=
- List_Containing (Current_Use_Clause (Scope (Id)))
+ and then not In_Same_List (Current_Use_Clause (Scope (Prev)),
+ Current_Use_Clause (Scope (Id)))
then
Set_Is_Potentially_Use_Visible (Prev, False);
Append_Elmt (Prev, Hidden_By_Use_Clause (N));
then
declare
Opnd : Node_Id;
+
begin
if Nkind (N) = N_Function_Call then
Opnd := First_Actual (N);
if Ekind (Etype (Opnd)) = E_Anonymous_Access_Type
and then
- List_Containing (Parent (Designated_Type (Etype (Opnd))))
- = List_Containing (Unit_Declaration_Node (User_Subp))
+ In_Same_List (Parent (Designated_Type (Etype (Opnd))),
+ Unit_Declaration_Node (User_Subp))
then
if It2.Nam = Predef_Subp then
return It1;
projects / thirdparty / gcc.git / commitdiff
