From 64f49c80456f3552dab6aaaad487cbb1913315f3 Mon Sep 17 00:00:00 2001 From: charlet Date: Thu, 9 Sep 2010 09:35:11 +0000 Subject: [PATCH] 2010-09-09 Robert Dewar * 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 * 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 * par-ch5.adb: Minor reformatting. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@164056 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 19 ++++ gcc/ada/nlists.adb | 243 ++++++++++++++++++++++++++++----------------------- gcc/ada/nlists.ads | 129 ++++++++++++++++----------- gcc/ada/par-ch5.adb | 24 ++--- gcc/ada/par-labl.adb | 8 +- gcc/ada/restrict.adb | 24 +++++ gcc/ada/restrict.ads | 6 ++ gcc/ada/sem_ch3.adb | 28 +++--- gcc/ada/sem_ch6.adb | 16 ++-- gcc/ada/sem_ch8.adb | 17 +++- gcc/ada/sem_type.adb | 5 +- 11 files changed, 317 insertions(+), 202 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index cf4023d..c0c3e10 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,24 @@ 2010-09-09 Robert Dewar + * 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 + + * 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 + + * par-ch5.adb: Minor reformatting. + +2010-09-09 Robert Dewar + * prj-env.adb: Minor code reorganization. * par-ch3.adb: Minor reformatting. * gcc-interface/Make-lang.in: Update dependencies. diff --git a/gcc/ada/nlists.adb b/gcc/ada/nlists.adb index fe4d27c..453e665 100644 --- a/gcc/ada/nlists.adb +++ b/gcc/ada/nlists.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -52,10 +52,10 @@ package body Nlists is -- 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; @@ -85,16 +85,16 @@ package body Nlists is -- 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, @@ -104,23 +104,23 @@ package body Nlists is -- 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 @@ -128,8 +128,8 @@ package body Nlists is -- 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); @@ -149,8 +149,8 @@ package body Nlists is -- 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); @@ -230,9 +230,9 @@ package body Nlists is 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); @@ -272,7 +272,7 @@ package body Nlists is -- 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; @@ -281,7 +281,7 @@ package body Nlists is -- 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; @@ -295,8 +295,8 @@ package body Nlists is -- 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 @@ -329,11 +329,22 @@ package body Nlists is 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 @@ -366,8 +377,8 @@ package body Nlists is 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 @@ -390,8 +401,10 @@ package body Nlists is -- 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 @@ -424,8 +437,8 @@ package body Nlists is 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 @@ -448,7 +461,7 @@ package body Nlists is -- 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); @@ -479,11 +492,11 @@ package body Nlists is 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); @@ -515,7 +528,7 @@ package body Nlists is -- 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); @@ -546,11 +559,11 @@ package body Nlists is 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); @@ -591,7 +604,7 @@ package body Nlists is -- 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; @@ -609,7 +622,7 @@ package body Nlists is -- 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; @@ -628,8 +641,8 @@ package body Nlists is -- 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; @@ -642,7 +655,7 @@ package body Nlists is -- 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); @@ -654,7 +667,7 @@ package body Nlists is function List_Length (List : List_Id) return Nat is Result : Nat; - Node : Node_Id; + Node : Node_Or_Entity_Id; begin Result := 0; @@ -698,7 +711,7 @@ package body Nlists is 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 @@ -723,7 +736,7 @@ package body Nlists is 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 @@ -790,7 +803,7 @@ package body Nlists is -- 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); @@ -838,14 +851,21 @@ package body Nlists is 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); @@ -853,7 +873,12 @@ package body Nlists is 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); @@ -863,11 +888,11 @@ package body Nlists is 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 @@ -879,12 +904,12 @@ package body Nlists is 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 @@ -900,13 +925,13 @@ package body Nlists is -- 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; @@ -924,22 +949,22 @@ package body Nlists is -- 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; @@ -966,10 +991,10 @@ package body Nlists is -- 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 @@ -981,7 +1006,7 @@ package body Nlists is -- 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; @@ -991,8 +1016,8 @@ package body Nlists is -- 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); @@ -1007,8 +1032,8 @@ package body Nlists is -- 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); @@ -1088,9 +1113,9 @@ package body Nlists is 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); @@ -1130,7 +1155,7 @@ package body Nlists is -- 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; @@ -1148,13 +1173,13 @@ package body Nlists is -- 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; @@ -1172,8 +1197,10 @@ package body Nlists is -- 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; @@ -1185,7 +1212,7 @@ package body Nlists is 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; @@ -1194,10 +1221,10 @@ package body Nlists is -- 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); @@ -1241,8 +1268,8 @@ package body Nlists is -- 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); @@ -1271,7 +1298,7 @@ package body Nlists is else declare - Nxt : constant Node_Id := Next (Frst); + Nxt : constant Node_Or_Entity_Id := Next (Frst); begin Set_First (List, Nxt); @@ -1293,8 +1320,10 @@ package body Nlists is -- 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); @@ -1318,8 +1347,8 @@ package body Nlists is 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); @@ -1343,7 +1372,7 @@ package body Nlists is -- 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; @@ -1352,7 +1381,7 @@ package body Nlists is -- 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; @@ -1361,7 +1390,7 @@ package body Nlists is -- 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; @@ -1370,7 +1399,7 @@ package body Nlists is -- 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; @@ -1379,7 +1408,7 @@ package body Nlists is -- 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; @@ -1389,7 +1418,7 @@ package body Nlists is -- 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; diff --git a/gcc/ada/nlists.ads b/gcc/ada/nlists.ads index cecf3a2..10c04ed 100644 --- a/gcc/ada/nlists.ads +++ b/gcc/ada/nlists.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -49,6 +49,10 @@ package Nlists is -- 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 @@ -70,33 +74,42 @@ package Nlists is -- 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; @@ -108,12 +121,12 @@ package Nlists is 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 @@ -122,14 +135,14 @@ package Nlists 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 @@ -141,42 +154,44 @@ package Nlists is -- 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 @@ -185,7 +200,7 @@ package Nlists is -- 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); @@ -199,23 +214,23 @@ package Nlists is -- 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 @@ -227,56 +242,72 @@ package Nlists is 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 @@ -302,13 +333,13 @@ package Nlists is -- 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 @@ -322,7 +353,7 @@ package Nlists is -- 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. @@ -332,7 +363,7 @@ package Nlists is -- 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 diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb index ec1bceb..d9d64d7 100644 --- a/gcc/ada/par-ch5.adb +++ b/gcc/ada/par-ch5.adb @@ -334,10 +334,10 @@ package body Ch5 is 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 @@ -350,7 +350,7 @@ package body Ch5 is -- 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; @@ -358,8 +358,8 @@ package body Ch5 is 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 @@ -385,9 +385,9 @@ package body Ch5 is 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); @@ -397,8 +397,8 @@ package body Ch5 is 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 diff --git a/gcc/ada/par-labl.adb b/gcc/ada/par-labl.adb index 6609a07..8520292 100644 --- a/gcc/ada/par-labl.adb +++ b/gcc/ada/par-labl.adb @@ -378,12 +378,10 @@ procedure Labl is -- 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; diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index 2beae88..229369e 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.adb @@ -25,6 +25,7 @@ with Atree; use Atree; with Casing; use Casing; +with Einfo; use Einfo; with Errout; use Errout; with Debug; use Debug; with Fname; use Fname; @@ -396,6 +397,29 @@ package body Restrict is 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 -- ---------------------------------------- diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads index a0c5df0..ecac63c 100644 --- a/gcc/ada/restrict.ads +++ b/gcc/ada/restrict.ads @@ -239,6 +239,12 @@ package Restrict is -- 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 diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index d5b39f9..0e9329c 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -2960,13 +2960,7 @@ package body Sem_Ch3 is -- 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 @@ -13677,8 +13671,20 @@ package body Sem_Ch3 is 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; @@ -14211,13 +14217,7 @@ package body Sem_Ch3 is -- 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; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 9a67243..baf5398 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1638,9 +1638,7 @@ package body Sem_Ch6 is 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; @@ -1649,10 +1647,12 @@ package body Sem_Ch6 is 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); @@ -7993,9 +7993,7 @@ package body Sem_Ch6 is ("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 diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 71d6813..ef72d3f 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -454,8 +454,9 @@ package body Sem_Ch8 is -- 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; @@ -4411,6 +4412,10 @@ package body Sem_Ch8 is <> 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 @@ -4960,6 +4965,10 @@ package body Sem_Ch8 is 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)). @@ -7330,8 +7339,8 @@ package body Sem_Ch8 is 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)); diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index b196286..12d1327 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -1866,6 +1866,7 @@ package body Sem_Type is then declare Opnd : Node_Id; + begin if Nkind (N) = N_Function_Call then Opnd := First_Actual (N); @@ -1875,8 +1876,8 @@ package body Sem_Type is 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; -- 2.7.4