nlists.ads, nlists.adb (In_Same_List): New function.

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.

From-SVN: r164056

gcc/ada/ChangeLog

 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.
 	* par-ch3.adb: Minor reformatting.
 	* gcc-interface/Make-lang.in: Update dependencies.

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

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;
 

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 --
    ----------------------------------------

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

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;

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

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
 
       <<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
@@ -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));

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;