2011-08-31 Jose Ruiz <ruiz@adacore.com>

	* s-taprop-vxworks.adb, s-taprop-mingw.adb, s-taprop-linux.adb,
	s-taprop-solaris.adb (Create_Task): Not_A_Specific_CPU can be assigned
	to any dispatching domain.

2011-08-31  Thomas Quinot  <quinot@adacore.com>

	* exp_ch4.adb: Minor reformatting.

2011-08-31  Bob Duff  <duff@adacore.com>

	* sem_ch6.adb (Get_Generic_Parent_Type): Don't query Subtype_Indication
	on nodes for which it is not defined.
	(Is_Non_Overriding_Operation): Exit the loop when we find a generic
	parent type.

2011-08-31  Bob Duff  <duff@adacore.com>

	* sem_ch3.adb (Process_Full_View): Disable legality check if
	In_Instance, to avoid spurious errors.
	* sem_ch12.adb (Validate_Derived_Type_Instance): Disable legality check
	if In_Instance, to avoid spurious errors.

2011-08-31  Pascal Obry  <obry@adacore.com>

	* a-direct.adb: Use Dir_Seps everywhere to properly handle all
	directory speparators.
	(Compose): Use Dir_Seps to handle both forms.
	(Create_Path): Use Dir_Seps instead of explicit check, no semantic
	changes.
	(Extension): Use Dir_Seps to handle both forms.

2011-08-31  Pascal Obry  <obry@adacore.com>

	* prj-conf.adb: Minor reformatting.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@178372 138bc75d-0d04-0410-961f-82ee72b054a4

11 files changed, 151 insertions, 81 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 58e43deeec1..1fb208879d7 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,42 @@
 2011-08-31  Jose Ruiz  <ruiz@adacore.com>
 
+	* s-taprop-vxworks.adb, s-taprop-mingw.adb, s-taprop-linux.adb,
+	s-taprop-solaris.adb (Create_Task): Not_A_Specific_CPU can be assigned
+	to any dispatching domain.
+
+2011-08-31  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_ch4.adb: Minor reformatting.
+
+2011-08-31  Bob Duff  <duff@adacore.com>
+
+	* sem_ch6.adb (Get_Generic_Parent_Type): Don't query Subtype_Indication
+	on nodes for which it is not defined.
+	(Is_Non_Overriding_Operation): Exit the loop when we find a generic
+	parent type.
+
+2011-08-31  Bob Duff  <duff@adacore.com>
+
+	* sem_ch3.adb (Process_Full_View): Disable legality check if
+	In_Instance, to avoid spurious errors.
+	* sem_ch12.adb (Validate_Derived_Type_Instance): Disable legality check
+	if In_Instance, to avoid spurious errors.
+
+2011-08-31  Pascal Obry  <obry@adacore.com>
+
+	* a-direct.adb: Use Dir_Seps everywhere to properly handle all
+	directory speparators.
+	(Compose): Use Dir_Seps to handle both forms.
+	(Create_Path): Use Dir_Seps instead of explicit check, no semantic
+	changes.
+	(Extension): Use Dir_Seps to handle both forms.
+
+2011-08-31  Pascal Obry  <obry@adacore.com>
+
+	* prj-conf.adb: Minor reformatting.
+
+2011-08-31  Jose Ruiz  <ruiz@adacore.com>
+
 	* aspects.ads (Aspect_Id, Aspect_Argument, Aspect_Names): Add the
 	dispatching domain aspect.
 	* aspects.adb (Canonical_Aspect): Add entry for the dispatching domain
diff --git a/gcc/ada/a-direct.adb b/gcc/ada/a-direct.adb
index 6bb499ee2e8..b9dee7fdcdd 100644
--- a/gcc/ada/a-direct.adb
+++ b/gcc/ada/a-direct.adb
@@ -32,7 +32,7 @@
 with Ada.Calendar;               use Ada.Calendar;
 with Ada.Calendar.Formatting;    use Ada.Calendar.Formatting;
 with Ada.Directories.Validity;   use Ada.Directories.Validity;
-with Ada.Strings.Maps;
+with Ada.Strings.Maps;           use Ada; use Ada.Strings.Maps;
 with Ada.Strings.Fixed;
 with Ada.Strings.Unbounded;      use Ada.Strings.Unbounded;
 with Ada.Unchecked_Conversion;
@@ -61,8 +61,7 @@ package body Ada.Directories is
    pragma Import (C, Dir_Separator, "__gnat_dir_separator");
    --  Running system default directory separator
 
-   Dir_Seps : constant Ada.Strings.Maps.Character_Set :=
-                Ada.Strings.Maps.To_Set ("/\");
+   Dir_Seps : constant Character_Set := Strings.Maps.To_Set ("/\");
    --  UNIX and DOS style directory separators
 
    Max_Path : Integer;
@@ -175,7 +174,7 @@ package body Ada.Directories is
 
          --  Add a directory separator if needed
 
-         if Last /= 0 and then Result (Last) /= Dir_Separator then
+         if Last /= 0 and then not Is_In (Result (Last), Dir_Seps) then
             Last := Last + 1;
             Result (Last) := Dir_Separator;
          end if;
@@ -457,17 +456,13 @@ package body Ada.Directories is
 
             --  Look for the end of an intermediate directory
 
-            if New_Dir (J) /= Dir_Separator and then
-               New_Dir (J) /= '/'
-            then
+            if not Is_In (New_Dir (J), Dir_Seps) then
                Last := J;
 
             --  We have found a new intermediate directory each time we find
             --  a first directory separator.
 
-            elsif New_Dir (J - 1) /= Dir_Separator and then
-                  New_Dir (J - 1) /= '/'
-            then
+            elsif not Is_In (New_Dir (J - 1), Dir_Seps) then
 
                --  No need to create the directory if it already exists
 
@@ -664,7 +659,7 @@ package body Ada.Directories is
             --  If a directory separator is found before a dot, there is no
             --  extension.
 
-            if Name (Pos) = Dir_Separator then
+            if Is_In (Name (Pos), Dir_Seps) then
                return Empty_String;
 
             elsif Name (Pos) = '.' then
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index e7d179150e3..3811e19c083 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -7920,7 +7920,12 @@ package body Exp_Ch4 is
       --  Insert explicit dereference if required
 
       if Is_Access_Type (Ptyp) then
-         Set_Etype (P, Ptyp); -- in case it's private
+
+         --  First set prefix type to proper access type, in case it currently
+         --  has a private (non-access) view of this type.
+
+         Set_Etype (P, Ptyp);
+
          Insert_Explicit_Dereference (P);
          Analyze_And_Resolve (P, Designated_Type (Ptyp));
 
diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb
index 76a028e66cd..ae1d0c6ed7a 100644
--- a/gcc/ada/prj-conf.adb
+++ b/gcc/ada/prj-conf.adb
@@ -162,12 +162,12 @@ package body Prj.Conf is
                --  configuration list.
 
                declare
-                  Conf_List : String_List_Id := Conf_Attr.Value.Values;
-                  Conf_Elem : String_Element;
                   User_List : constant String_List_Id :=
                                 User_Attr.Value.Values;
-                  New_List : String_List_Id;
-                  New_Elem : String_Element;
+                  Conf_List : String_List_Id := Conf_Attr.Value.Values;
+                  Conf_Elem : String_Element;
+                  New_List  : String_List_Id;
+                  New_Elem  : String_Element;
 
                begin
                   --  Create new list
@@ -525,7 +525,7 @@ package body Prj.Conf is
             if Proj.Project.Qualifier = Aggregate then
                declare
                   List : Aggregated_Project_List :=
-                    Proj.Project.Aggregated_Projects;
+                           Proj.Project.Aggregated_Projects;
                begin
                   while List /= null loop
                      Debug_Output
@@ -549,12 +549,13 @@ package body Prj.Conf is
    ------------------
 
    function Check_Target
-     (Config_File  : Project_Id;
+     (Config_File        : Project_Id;
       Autoconf_Specified : Boolean;
-      Project_Tree : Prj.Project_Tree_Ref;
-      Target       : String := "") return Boolean
+      Project_Tree       : Prj.Project_Tree_Ref;
+      Target             : String := "") return Boolean
    is
-      Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
+      Shared   : constant Shared_Project_Tree_Data_Access :=
+                   Project_Tree.Shared;
       Variable : constant Variable_Value :=
                    Value_Of
                      (Name_Target, Config_File.Decl.Attributes, Shared);
@@ -712,6 +713,7 @@ package body Prj.Conf is
       -------------------------
 
       function Get_Config_Switches return Argument_List_Access is
+
          package Language_Htable is new GNAT.HTable.Simple_HTable
            (Header_Num => Prj.Header_Num,
             Element    => Name_Id,
@@ -731,6 +733,10 @@ package body Prj.Conf is
          --  Add all --config switches for this project. This is also called
          --  for aggregate projects.
 
+         -------------------------------------
+         -- Add_Config_Switches_For_Project --
+         -------------------------------------
+
          procedure Add_Config_Switches_For_Project
            (Project    : Project_Id;
             Tree       : Project_Tree_Ref;
@@ -828,9 +834,9 @@ package body Prj.Conf is
 
       begin
          For_Every_Imported_Project
-           (By         => Project,
-            Tree       => Project_Tree,
-            With_State => Dummy,
+           (By                 => Project,
+            Tree               => Project_Tree,
+            With_State         => Dummy,
             Include_Aggregated => True);
 
          Name  := Language_Htable.Get_First;
@@ -859,10 +865,10 @@ package body Prj.Conf is
 
             declare
                Config_Command : constant String :=
-                 "--config=" & Get_Name_String (Name);
+                                  "--config=" & Get_Name_String (Name);
 
                Runtime_Name   : constant String :=
-                 Runtime_Name_For (Name);
+                                  Runtime_Name_For (Name);
 
             begin
                if Variable = Nil_Variable_Value
@@ -876,7 +882,7 @@ package body Prj.Conf is
 
                   declare
                      Compiler_Command : constant String :=
-                       Get_Name_String (Variable.Value);
+                                          Get_Name_String (Variable.Value);
 
                   begin
                      if Is_Absolute_Path (Compiler_Command) then
@@ -1245,8 +1251,8 @@ package body Prj.Conf is
       end if;
 
       if Config_File_Path = null then
-         if (not Allow_Automatic_Generation) and then
-            Config_File_Name /= ""
+         if (not Allow_Automatic_Generation)
+           and then Config_File_Name /= ""
          then
             Raise_Invalid_Config
               ("could not locate main configuration project "
@@ -1386,18 +1392,18 @@ package body Prj.Conf is
 
       Prj.Initialize (Project_Tree);
 
-      Main_Project      := No_Project;
+      Main_Project := No_Project;
       Automatically_Generated := False;
 
       Prj.Part.Parse
-        (In_Tree                => Project_Node_Tree,
-         Project                => User_Project_Node,
-         Project_File_Name      => Project_File_Name,
-         Errout_Handling        => Prj.Part.Finalize_If_Error,
-         Packages_To_Check      => Packages_To_Check,
-         Current_Directory      => Current_Directory,
-         Is_Config_File         => False,
-         Env                    => Env);
+        (In_Tree           => Project_Node_Tree,
+         Project           => User_Project_Node,
+         Project_File_Name => Project_File_Name,
+         Errout_Handling   => Prj.Part.Finalize_If_Error,
+         Packages_To_Check => Packages_To_Check,
+         Current_Directory => Current_Directory,
+         Is_Config_File    => False,
+         Env               => Env);
 
       if User_Project_Node = Empty_Node then
          User_Project_Node := Empty_Node;
@@ -1442,9 +1448,10 @@ package body Prj.Conf is
       On_Load_Config             : Config_File_Hook := null;
       Reset_Tree                 : Boolean := True)
    is
-      Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
+      Shared              : constant Shared_Project_Tree_Data_Access :=
+                              Project_Tree.Shared;
       Main_Config_Project : Project_Id;
-      Success : Boolean;
+      Success             : Boolean;
 
    begin
       Main_Project := No_Project;
@@ -1468,10 +1475,10 @@ package body Prj.Conf is
          if not Is_Absolute_Path (Project_Tree.Source_Info_File_Name.all) then
             declare
                Obj_Dir : constant Variable_Value :=
-                 Value_Of
-                   (Name_Object_Dir,
-                    Main_Project.Decl.Attributes,
-                    Shared);
+                           Value_Of
+                             (Name_Object_Dir,
+                              Main_Project.Decl.Attributes,
+                              Shared);
 
             begin
                if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
@@ -1523,16 +1530,16 @@ package body Prj.Conf is
       --  Finish processing the user's project
 
       Prj.Proc.Process_Project_Tree_Phase_2
-        (In_Tree                    => Project_Tree,
-         Project                    => Main_Project,
-         Success                    => Success,
-         From_Project_Node          => User_Project_Node,
-         From_Project_Node_Tree     => Project_Node_Tree,
-         Env                        => Env);
+        (In_Tree                => Project_Tree,
+         Project                => Main_Project,
+         Success                => Success,
+         From_Project_Node      => User_Project_Node,
+         From_Project_Node_Tree => Project_Node_Tree,
+         Env                    => Env);
 
       if Success then
-         if Project_Tree.Source_Info_File_Name /= null and then
-            not Project_Tree.Source_Info_File_Exists
+         if Project_Tree.Source_Info_File_Name /= null
+           and then not Project_Tree.Source_Info_File_Exists
          then
             Write_Source_Info_File (Project_Tree);
          end if;
diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb
index cc1650f8b4d..a80d14947db 100644
--- a/gcc/ada/s-taprop-linux.adb
+++ b/gcc/ada/s-taprop-linux.adb
@@ -823,6 +823,7 @@ package body System.Task_Primitives.Operations is
       --  processors for the domain.
 
       if T.Common.Domain /= null and then
+        T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU and then
         (T.Common.Base_CPU not in T.Common.Domain'Range
          or else not T.Common.Domain (T.Common.Base_CPU))
       then
diff --git a/gcc/ada/s-taprop-mingw.adb b/gcc/ada/s-taprop-mingw.adb
index 861ef245d66..0d380da2c52 100644
--- a/gcc/ada/s-taprop-mingw.adb
+++ b/gcc/ada/s-taprop-mingw.adb
@@ -895,12 +895,15 @@ package body System.Task_Primitives.Operations is
       Result         : DWORD;
       Entry_Point    : PTHREAD_START_ROUTINE;
 
+      use type System.Multiprocessors.CPU_Range;
+
    begin
       --  Check whether both Dispatching_Domain and CPU are specified for the
       --  task, and the CPU value is not contained within the range of
       --  processors for the domain.
 
       if T.Common.Domain /= null and then
+        T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU and then
         (T.Common.Base_CPU not in T.Common.Domain'Range
          or else not T.Common.Domain (T.Common.Base_CPU))
       then
diff --git a/gcc/ada/s-taprop-solaris.adb b/gcc/ada/s-taprop-solaris.adb
index f77061d08df..042fed25212 100644
--- a/gcc/ada/s-taprop-solaris.adb
+++ b/gcc/ada/s-taprop-solaris.adb
@@ -974,6 +974,7 @@ package body System.Task_Primitives.Operations is
       --  actual use.
 
       use System.Task_Info;
+      use type System.Multiprocessors.CPU_Range;
 
    begin
       --  Check whether both Dispatching_Domain and CPU are specified for the
@@ -981,6 +982,7 @@ package body System.Task_Primitives.Operations is
       --  processors for the domain.
 
       if T.Common.Domain /= null and then
+        T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU and then
         (T.Common.Base_CPU not in T.Common.Domain'Range
          or else not T.Common.Domain (T.Common.Base_CPU))
       then
diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb
index 86372226a5b..f0e9e038a83 100644
--- a/gcc/ada/s-taprop-vxworks.adb
+++ b/gcc/ada/s-taprop-vxworks.adb
@@ -890,12 +890,15 @@ package body System.Task_Primitives.Operations is
    is
       Adjusted_Stack_Size : size_t;
 
+      use type System.Multiprocessors.CPU_Range;
+
    begin
       --  Check whether both Dispatching_Domain and CPU are specified for the
       --  task, and the CPU value is not contained within the range of
       --  processors for the domain.
 
       if T.Common.Domain /= null and then
+        T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU and then
         (T.Common.Base_CPU not in T.Common.Domain'Range
          or else not T.Common.Domain (T.Common.Base_CPU))
       then
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index d759defb66f..af9555d7fae 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -10418,11 +10418,15 @@ package body Sem_Ch12 is
            and then not Is_Limited_Type (A_Gen_T)
            and then Ada_Version >= Ada_2012
          then
-            Error_Msg_NE
-              ("actual for non-limited & cannot be a limited type", Actual,
-               Gen_T);
-            Explain_Limited_Type (Act_T, Actual);
-            Abandon_Instantiation (Actual);
+            if In_Instance then
+               null;
+            else
+               Error_Msg_NE
+                 ("actual for non-limited & cannot be a limited type", Actual,
+                  Gen_T);
+               Explain_Limited_Type (Act_T, Actual);
+               Abandon_Instantiation (Actual);
+            end if;
          end if;
       end Validate_Derived_Type_Instance;
 
@@ -10556,11 +10560,15 @@ package body Sem_Ch12 is
          if Is_Limited_Type (Act_T)
            and then not Is_Limited_Type (A_Gen_T)
          then
-            Error_Msg_NE
-              ("actual for non-limited & cannot be a limited type", Actual,
-               Gen_T);
-            Explain_Limited_Type (Act_T, Actual);
-            Abandon_Instantiation (Actual);
+            if In_Instance then
+               null;
+            else
+               Error_Msg_NE
+                 ("actual for non-limited & cannot be a limited type", Actual,
+                  Gen_T);
+               Explain_Limited_Type (Act_T, Actual);
+               Abandon_Instantiation (Actual);
+            end if;
 
          elsif Known_To_Have_Preelab_Init (A_Gen_T)
            and then not Has_Preelaborable_Initialization (Act_T)
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 25134b6dc7c..542ffee3f51 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -2868,8 +2868,8 @@ package body Sem_Ch3 is
 
       --   2. Those generated by the Expression
 
-      --   3. Those used to constrained the Object Definition with the
-      --       expression constraints when it is unconstrained
+      --   3. Those used to constrain the Object Definition with the
+      --       expression constraints when the definition is unconstrained
 
       --  They must be generated in this order to avoid order of elaboration
       --  issues. Thus the first step (after entering the name) is to analyze
@@ -17399,9 +17399,13 @@ package body Sem_Ch3 is
         and then (Is_Limited_Type (Full_T)
                    or else Is_Limited_Composite (Full_T))
       then
-         Error_Msg_N
-           ("completion of nonlimited type cannot be limited", Full_T);
-         Explain_Limited_Type (Full_T, Full_T);
+         if In_Instance then
+            null;
+         else
+            Error_Msg_N
+              ("completion of nonlimited type cannot be limited", Full_T);
+            Explain_Limited_Type (Full_T, Full_T);
+         end if;
 
       elsif Is_Abstract_Type (Full_T)
         and then not Is_Abstract_Type (Priv_T)
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 290b53d7fcb..242cfcbca04 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -7214,6 +7214,7 @@ package body Sem_Ch6 is
 
       function Get_Generic_Parent_Type (F_Typ : Entity_Id) return Entity_Id is
          G_Typ : Entity_Id;
+         Defn  : Node_Id;
          Indic : Node_Id;
 
       begin
@@ -7226,19 +7227,21 @@ package body Sem_Ch6 is
             --  is needed for cases where a full derived type has been
             --  rewritten.)
 
-            Indic := Subtype_Indication
-                       (Type_Definition (Original_Node (Parent (F_Typ))));
+            Defn := Type_Definition (Original_Node (Parent (F_Typ)));
+            if Nkind (Defn) = N_Derived_Type_Definition then
+               Indic := Subtype_Indication (Defn);
 
-            if Nkind (Indic) = N_Subtype_Indication then
-               G_Typ := Entity (Subtype_Mark (Indic));
-            else
-               G_Typ := Entity (Indic);
-            end if;
+               if Nkind (Indic) = N_Subtype_Indication then
+                  G_Typ := Entity (Subtype_Mark (Indic));
+               else
+                  G_Typ := Entity (Indic);
+               end if;
 
-            if Nkind (Parent (G_Typ)) = N_Subtype_Declaration
-              and then Present (Generic_Parent_Type (Parent (G_Typ)))
-            then
-               return Generic_Parent_Type (Parent (G_Typ));
+               if Nkind (Parent (G_Typ)) = N_Subtype_Declaration
+                 and then Present (Generic_Parent_Type (Parent (G_Typ)))
+               then
+                  return Generic_Parent_Type (Parent (G_Typ));
+               end if;
             end if;
          end if;
 
@@ -7295,9 +7298,10 @@ package body Sem_Ch6 is
         and then In_Private_Part (Current_Scope)
         and then Comes_From_Source (New_E)
       then
-         --  We examine the formals and result subtype of the inherited
-         --  operation, to determine whether their type is derived from (the
-         --  instance of) a generic type.
+         --  We examine the formals and result type of the inherited operation,
+         --  to determine whether their type is derived from (the instance of)
+         --  a generic type. The first such formal or result type is the one
+         --  tested.
 
          Formal := First_Formal (Prev_E);
          while Present (Formal) loop
@@ -7308,6 +7312,7 @@ package body Sem_Ch6 is
             end if;
 
             G_Typ := Get_Generic_Parent_Type (F_Typ);
+            exit when Present (G_Typ);
 
             Next_Formal (Formal);
          end loop;