2010-09-10 Eric Botcazou <ebotcazou@adacore.com>

	* exp_disp.adb: Minor reformatting.

2010-09-10  Arnaud Charlet  <charlet@adacore.com>

	* sem_prag.adb (Analyze_Pragma): Ignore Inline_Always pragma in
	CodePeer mode.

2010-09-10  Thomas Quinot  <quinot@adacore.com>

	* sem_res.adb: Minor reformatting.
	* exp_ch9.adb, rtsfind.ads, exp_ch4.adb, exp_ch3.adb: Do not hardcode
	magic constants for task master levels (instead, reference
	named numbers from System.Tasking).

2010-09-10  Eric Botcazou  <ebotcazou@adacore.com>

	* gnatvsn.ads (Ver_Prefix): New constant string.
	* bindgen.adb (Gen_Output_File_Ada): Use it in lieu of hardcoded value.
	(Gen_Output_File_C): Likewise.
	* g-comver.adb (Ver_Prefix): Add cross-reference to Gnatvsn.Ver_Prefix
	in comment.
	
2010-09-10  Ed Schonberg  <schonberg@adacore.com>

	* sem.adb (Walk_Library_Items): Do not traverse children of the main
	unit, to prevent spurious circularities in the walk order.
	(Depends_On_Main): Use elsewhere to prevent circularities when the body
	of an ancestor of the main unit depends on a child of the main unit.



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

12 files changed, 145 insertions, 69 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e03ced62b80..2490a89e22e 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,34 @@
+2010-09-10  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* exp_disp.adb: Minor reformatting.
+
+2010-09-10  Arnaud Charlet  <charlet@adacore.com>
+
+	* sem_prag.adb (Analyze_Pragma): Ignore Inline_Always pragma in
+	CodePeer mode.
+
+2010-09-10  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_res.adb: Minor reformatting.
+	* exp_ch9.adb, rtsfind.ads, exp_ch4.adb, exp_ch3.adb: Do not hardcode
+	magic constants for task master levels (instead, reference
+	named numbers from System.Tasking).
+
+2010-09-10  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnatvsn.ads (Ver_Prefix): New constant string.
+	* bindgen.adb (Gen_Output_File_Ada): Use it in lieu of hardcoded value.
+	(Gen_Output_File_C): Likewise.
+	* g-comver.adb (Ver_Prefix): Add cross-reference to Gnatvsn.Ver_Prefix
+	in comment.
+	
+2010-09-10  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem.adb (Walk_Library_Items): Do not traverse children of the main
+	unit, to prevent spurious circularities in the walk order.
+	(Depends_On_Main): Use elsewhere to prevent circularities when the body
+	of an ancestor of the main unit depends on a child of the main unit.
+
 2010-09-10  Robert Dewar  <dewar@adacore.com>
 
 	* gnatlink.adb, prj-ext.adb, prj-util.adb, s-tporft.adb,
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index 28a0453fb6c..e87ff50aa0c 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -2341,7 +2341,7 @@ package body Bindgen is
 
          WBI ("");
          WBI ("   GNAT_Version : constant String :=");
-         WBI ("                    ""GNAT Version: " &
+         WBI ("                    """ & Ver_Prefix &
                                    Gnat_Version_String &
                                    """ & ASCII.NUL;");
          WBI ("   pragma Export (C, GNAT_Version, ""__gnat_version"");");
@@ -2750,7 +2750,7 @@ package body Bindgen is
 
       if Bind_Main_Program then
          WBI ("");
-         WBI ("char __gnat_version[] = ""GNAT Version: " &
+         WBI ("char __gnat_version[] = """ & Ver_Prefix &
                                    Gnat_Version_String & """;");
 
          Set_String ("char __gnat_ada_main_program_name[] = """);
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 1aec34c013a..84e01efe23f 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -1481,12 +1481,8 @@ package body Exp_Ch3 is
 
       if Has_Task (Full_Type) then
          if Restriction_Active (No_Task_Hierarchy) then
-
-            --  3 is System.Tasking.Library_Task_Level
-            --  (should be rtsfindable constant ???)
-
-            Append_To (Args, Make_Integer_Literal (Loc, 3));
-
+            Append_To (Args,
+              New_Occurrence_Of (RTE (RE_Library_Task_Level), Loc));
          else
             Append_To (Args, Make_Identifier (Loc, Name_uMaster));
          end if;
@@ -2042,10 +2038,8 @@ package body Exp_Ch3 is
 
          if Has_Task (Rec_Type) then
             if Restriction_Active (No_Task_Hierarchy) then
-
-               --  3 is System.Tasking.Library_Task_Level
-
-               Append_To (Args, Make_Integer_Literal (Loc, 3));
+               Append_To (Args,
+                 New_Occurrence_Of (RTE (RE_Library_Task_Level), Loc));
             else
                Append_To (Args, Make_Identifier (Loc, Name_uMaster));
             end if;
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index fe403c8b75b..dad493cbe06 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -3724,8 +3724,8 @@ package body Exp_Ch4 is
                   end if;
 
                   if Restriction_Active (No_Task_Hierarchy) then
-                     --  3 is System.Tasking.Library_Task_Level
-                     Append_To (Args, Make_Integer_Literal (Loc, 3));
+                     Append_To (Args,
+                       New_Occurrence_Of (RTE (RE_Library_Task_Level), Loc));
                   else
                      Append_To (Args,
                        New_Reference_To
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 7d6b0f983a8..f272b951b1c 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -12133,13 +12133,14 @@ package body Exp_Ch9 is
 
          --  Master parameter. This is a reference to the _Master parameter of
          --  the initialization procedure, except in the case of the pragma
-         --  Restrictions (No_Task_Hierarchy) where the value is fixed to 3
-         --  (3 is System.Tasking.Library_Task_Level).
+         --  Restrictions (No_Task_Hierarchy) where the value is fixed to
+         --  System.Tasking.Library_Task_Level.
 
          if Restriction_Active (No_Task_Hierarchy) = False then
             Append_To (Args, Make_Identifier (Loc, Name_uMaster));
          else
-            Append_To (Args, Make_Integer_Literal (Loc, 3));
+            Append_To (Args,
+              New_Occurrence_Of (RTE (RE_Library_Task_Level), Loc));
          end if;
       end if;
 
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 9ecca31dde1..2517071ebe2 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -6667,8 +6667,8 @@ package body Exp_Disp is
          end;
       end if;
 
-      --  Mark entities of dispatch table. Required by the back end to
-      --  handle them properly.
+      --  Mark entities of dispatch table. Required by the back end to handle
+      --  them properly.
 
       if Present (DT) then
          Set_Is_Dispatch_Table_Entity (DT);
diff --git a/gcc/ada/g-comver.adb b/gcc/ada/g-comver.adb
index 7a6baa102f7..b71cadcf856 100644
--- a/gcc/ada/g-comver.adb
+++ b/gcc/ada/g-comver.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2002-2008, AdaCore                     --
+--                     Copyright (C) 2002-2010, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -42,7 +42,8 @@ package body GNAT.Compiler_Version is
    --  import this directly since run-time units cannot WITH compiler units.
 
    Ver_Prefix : constant String := "GNAT Version: ";
-   --  Prefix generated by binder
+   --  This is logically a reference to Gnatvsn.Ver_Prefix but we cannot
+   --  import this directly since run-time units cannot WITH compiler units.
 
    GNAT_Version : constant String (1 .. Ver_Len_Max + Ver_Prefix'Length);
    pragma Import (C, GNAT_Version, "__gnat_version");
diff --git a/gcc/ada/gnatvsn.ads b/gcc/ada/gnatvsn.ads
index 684a3bb4d79..f112c96c259 100644
--- a/gcc/ada/gnatvsn.ads
+++ b/gcc/ada/gnatvsn.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2010 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- --
@@ -77,6 +77,10 @@ package Gnatvsn is
    --  value should never be decreased in the future, but it would be
    --  OK to increase it if absolutely necessary.
 
+   Ver_Prefix : constant String := "GNAT Version: ";
+   --  Prefix generated by binder. If it is changed, be sure to change
+   --  GNAT.Compiler_Version.Ver_Prefix as well.
+
    Library_Version : constant String := "4.6";
    --  Library version. This value must be updated whenever any change to the
    --  compiler affects the library formats in such a way as to obsolete
diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index 2276e80d7ab..c0744c41cbb 100644
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.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- --
@@ -1396,6 +1396,11 @@ package Rtsfind is
      RE_Conditional_Call,                -- System.Tasking
      RE_Asynchronous_Call,               -- System.Tasking
 
+     RE_Foreign_Task_Level,              -- System.Tasking
+     RE_Environment_Task_Level,          -- System.Tasking
+     RE_Independent_Task_Level,          -- System.Tasking
+     RE_Library_Task_Level,              -- System.Tasking
+
      RE_Ada_Task_Control_Block,          -- System.Tasking
 
      RE_Task_List,                       -- System.Tasking
@@ -2561,6 +2566,11 @@ package Rtsfind is
      RE_Conditional_Call                 => System_Tasking,
      RE_Asynchronous_Call                => System_Tasking,
 
+     RE_Foreign_Task_Level               => System_Tasking,
+     RE_Environment_Task_Level           => System_Tasking,
+     RE_Independent_Task_Level           => System_Tasking,
+     RE_Library_Task_Level               => System_Tasking,
+
      RE_Ada_Task_Control_Block           => System_Tasking,
 
      RE_Task_List                        => System_Tasking,
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index d3d07cb74a7..90304b3c47e 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -1539,6 +1539,23 @@ package body Sem is
       --  context of some other unit. We do not want this to force processing
       --  of the main body before all other units have been processed.
 
+      function Depends_On_Main (CU : Node_Id) return Boolean;
+      --  The body of a unit that is withed by the spec of the main unit
+      --  may in turn have a with_clause on that spec. In that case do not
+      --  traverse the body, to prevent loops. It can also happen that the
+      --  main body has a with_clause on a child, which of course has an
+      --  implicit with on its parent. It's OK to traverse the child body
+      --  if the main spec has been processed, otherwise we also have a
+      --  circularity to avoid.
+
+      --  Another circularity pattern occurs when the main unit is a child unit
+      --  and the body of an ancestor has a with-clause of the main unit or on
+      --  one of its children. In both cases the body in question has a with-
+      --  clause on the main unit, and must be excluded from the traversal. In
+      --  some convoluted cases this may lead to a CodePeer error because the
+      --  spec of a subprogram declared in an instance within the parent will
+      --  not be seen in the main unit.
+
       procedure Do_Action (CU : Node_Id; Item : Node_Id);
       --  Calls Action, with some validity checks
 
@@ -1558,6 +1575,39 @@ package body Sem is
       --  is processed wherever it appears in the list of units, while the body
       --  is processed as the last unit in the list.
 
+      ---------------------
+      -- Depends_On_Main --
+      ---------------------
+
+      function Depends_On_Main (CU : Node_Id) return Boolean is
+         CL  : Node_Id;
+         MCU : constant Node_Id := Unit (Main_CU);
+
+      begin
+         CL := First (Context_Items (CU));
+
+         --  Problem does not arise with main subprograms
+
+         if
+           not Nkind_In (MCU, N_Package_Body, N_Package_Declaration)
+         then
+            return False;
+         end if;
+
+         while Present (CL) loop
+            if Nkind (CL) = N_With_Clause
+              and then Library_Unit (CL) = Main_CU
+              and then not Done (Get_Cunit_Unit_Number (Library_Unit (CL)))
+            then
+               return True;
+            end if;
+
+            Next (CL);
+         end loop;
+
+         return False;
+      end Depends_On_Main;
+
       ---------------
       -- Do_Action --
       ---------------
@@ -1812,45 +1862,6 @@ package body Sem is
 
          procedure Do_Withed_Units is new Walk_Withs (Do_Withed_Unit);
 
-         function Depends_On_Main (CU : Node_Id) return Boolean;
-         --  The body of a unit that is withed by the spec of the main unit
-         --  may in turn have a with_clause on that spec. In that case do not
-         --  traverse the body, to prevent loops. It can also happen that the
-         --  main body has a with_clause on a child, which of course has an
-         --  implicit with on its parent. It's OK to traverse the child body
-         --  if the main spec has been processed, otherwise we also have a
-         --  circularity to avoid.
-
-         ---------------------
-         -- Depends_On_Main --
-         ---------------------
-
-         function Depends_On_Main (CU : Node_Id) return Boolean is
-            CL : Node_Id;
-
-         begin
-            CL := First (Context_Items (CU));
-
-            --  Problem does not arise with main subprograms
-
-            if Nkind (Unit (Main_CU)) /= N_Package_Body then
-               return False;
-            end if;
-
-            while Present (CL) loop
-               if Nkind (CL) = N_With_Clause
-                 and then Library_Unit (CL) = Library_Unit (Main_CU)
-                 and then not Done (Get_Cunit_Unit_Number (Library_Unit (CL)))
-               then
-                  return True;
-               end if;
-
-               Next (CL);
-            end loop;
-
-            return False;
-         end Depends_On_Main;
-
       --  Start of processing for Process_Bodies_In_Context
 
       begin
@@ -1931,8 +1942,9 @@ package body Sem is
       Cur := First_Elmt (Comp_Unit_List);
       while Present (Cur) loop
          declare
-            CU : constant Node_Id := Node (Cur);
-            N  : constant Node_Id := Unit (CU);
+            CU  : constant Node_Id := Node (Cur);
+            N   : constant Node_Id := Unit (CU);
+            Par : Entity_Id;
 
          begin
             pragma Assert (Nkind (CU) = N_Compilation_Unit);
@@ -1969,10 +1981,26 @@ package body Sem is
                         Unit (Library_Unit (Main_CU)));
                   end if;
 
-               --  It's a spec, process it, and the units it depends on
+                  --  It's a spec, process it, and the units it depends on,
+                  --  unless it is a descendent of the main unit.  This can
+                  --  happen when the body of a parent depends on some other
+                  --  descendent.
 
                when others =>
-                  Do_Unit_And_Dependents (CU, N);
+                  Par := Scope (Defining_Entity (Unit (CU)));
+
+                  if Is_Child_Unit (Defining_Entity (Unit (CU))) then
+                     while Present (Par)
+                       and then Par /= Standard_Standard
+                       and then Par /= Cunit_Entity (Main_Unit)
+                     loop
+                        Par := Scope (Par);
+                     end loop;
+                  end if;
+
+                  if Par /= Cunit_Entity (Main_Unit) then
+                     Do_Unit_And_Dependents (CU, N);
+                  end if;
             end case;
          end;
 
@@ -2042,6 +2070,7 @@ package body Sem is
 
                   if Present (Body_CU)
                     and then not Seen (Get_Cunit_Unit_Number (Body_CU))
+                    and then not Depends_On_Main (Body_CU)
                   then
                      Body_U := Get_Cunit_Unit_Number (Body_CU);
                      Seen (Body_U) := True;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index f2b74b56440..fa8cff8afa8 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -8287,7 +8287,13 @@ package body Sem_Prag is
 
          when Pragma_Inline_Always =>
             GNAT_Pragma;
-            Process_Inline (True);
+
+            --  Pragma always active unless in CodePeer mode, since this causes
+            --  walk order issues.
+
+            if not CodePeer_Mode then
+               Process_Inline (True);
+            end if;
 
          --------------------
          -- Inline_Generic --
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index cc59f4d7d3d..519292b1827 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -9302,8 +9302,8 @@ package body Sem_Res is
          Index_Subtype := Create_Itype (Subtype_Kind (Ekind (Index_Type)), N);
 
          --  Take a new copy of Drange (where bounds have been rewritten to
-         --  reference side-effect-vree names). Using a separate tree ensures
-         --  that further expansion (e.g while rewriting a slice assignment
+         --  reference side-effect-free names). Using a separate tree ensures
+         --  that further expansion (e.g. while rewriting a slice assignment
          --  into a FOR loop) does not attempt to remove side effects on the
          --  bounds again (which would cause the bounds in the index subtype
          --  definition to refer to temporaries before they are defined) (the