2012-01-10 Bob Duff <duff@adacore.com>

	* sem_intr.adb (Check_Shift): Use RM_Size instead of Esize, when
	checking that the 'Size is correct. If the type is "mod 2**12",
	for example, it's illegal, but Esize is the 'Object_Size, which
	will be something like 16 or 32, so the error ('Size = 12) was
	not detected.
	* gnat_rm.texi: Improve documentation of shift
	and rotate intrinsics.

2012-01-10  Pascal Obry  <obry@adacore.com>

	* prj.adb (For_Every_Project_Imported): Fix
	implementation to make sure we return each project only once
	for aggragte libraries. It is fine to return a project twice for
	aggregate projects, this was the case as a Project_Id is different
	in each project tree. The new implementation use a table based on
	the project name to ensure proper detection of duplicate project
	in aggregate library. A new context is then created to continue
	retrurning duplicate project for aggregate libraries.



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

4 files changed, 140 insertions, 120 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 15175d0caeb..89a8830b4a5 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,24 @@
+2012-01-10  Bob Duff  <duff@adacore.com>
+
+	* sem_intr.adb (Check_Shift): Use RM_Size instead of Esize, when
+	checking that the 'Size is correct. If the type is "mod 2**12",
+	for example, it's illegal, but Esize is the 'Object_Size, which
+	will be something like 16 or 32, so the error ('Size = 12) was
+	not detected.
+	* gnat_rm.texi: Improve documentation of shift
+	and rotate intrinsics.
+
+2012-01-10  Pascal Obry  <obry@adacore.com>
+
+	* prj.adb (For_Every_Project_Imported): Fix
+	implementation to make sure we return each project only once
+	for aggragte libraries. It is fine to return a project twice for
+	aggregate projects, this was the case as a Project_Id is different
+	in each project tree. The new implementation use a table based on
+	the project name to ensure proper detection of duplicate project
+	in aggregate library. A new context is then created to continue
+	retrurning duplicate project for aggregate libraries.
+
 2012-01-09  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc-interface/trans.c (call_to_gnu): Create the temporary for the
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 908b177187b..fb2be33d96a 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -10385,11 +10385,7 @@ There are no restrictions on pragma @code{Restrictions}.
 * Exception_Name::
 * File::
 * Line::
-* Rotate_Left::
-* Rotate_Right::
-* Shift_Left::
-* Shift_Right::
-* Shift_Right_Arithmetic::
+* Shifts and Rotates::
 * Source_Location::
 @end menu
 
@@ -10506,61 +10502,35 @@ application program should simply call the function
 @code{GNAT.Source_Info.Line} to obtain the number of the current
 source line.
 
-@node Rotate_Left
-@section Rotate_Left
+@node Shifts and Rotates
+@section Shifts and Rotates
+@cindex Shift_Left
+@cindex Shift_Right
+@cindex Shift_Right_Arithmetic
 @cindex Rotate_Left
+@cindex Rotate_Right
 @noindent
-In standard Ada, the @code{Rotate_Left} function is available only
+In standard Ada, the shift and rotate functions are available only
 for the predefined modular types in package @code{Interfaces}.  However, in
-GNAT it is possible to define a Rotate_Left function for a user
-defined modular type or any signed integer type as in this example:
+GNAT it is possible to define these functions for any integer
+type (signed or modular), as in this example:
 
 @smallexample @c ada
    function Shift_Left
-     (Value  : My_Modular_Type;
+     (Value  : T;
       Amount : Natural)
-      return   My_Modular_Type;
+      return   T;
 @end smallexample
 
 @noindent
-The requirements are that the profile be exactly as in the example
-above.  The only modifications allowed are in the formal parameter
-names, and in the type of @code{Value} and the return type, which
-must be the same, and must be either a signed integer type, or
-a modular integer type with a binary modulus, and the size must
-be 8.  16, 32 or 64 bits.
-
-@node Rotate_Right
-@section Rotate_Right
-@cindex Rotate_Right
-@noindent
-A @code{Rotate_Right} function can be defined for any user defined
-binary modular integer type, or signed integer type, as described
-above for @code{Rotate_Left}.
-
-@node Shift_Left
-@section Shift_Left
-@cindex Shift_Left
-@noindent
-A @code{Shift_Left} function can be defined for any user defined
-binary modular integer type, or signed integer type, as described
-above for @code{Rotate_Left}.
-
-@node Shift_Right
-@section Shift_Right
-@cindex Shift_Right
-@noindent
-A @code{Shift_Right} function can be defined for any user defined
-binary modular integer type, or signed integer type, as described
-above for @code{Rotate_Left}.
-
-@node Shift_Right_Arithmetic
-@section Shift_Right_Arithmetic
-@cindex Shift_Right_Arithmetic
-@noindent
-A @code{Shift_Right_Arithmetic} function can be defined for any user
-defined binary modular integer type, or signed integer type, as described
-above for @code{Rotate_Left}.
+The function name must be one of
+Shift_Left, Shift_Right, Shift_Right_Arithmetic, Rotate_Left, or
+Rotate_Right. T must be an integer type. T'Size must be
+8, 16, 32 or 64 bits; if T is modular, the modulus
+must be 2**8, 2**16, 2**32 or 2**64.
+The result type must be the same as the type of @code{Value}.
+The shift amount must be Natural.
+The formal parameter names can be anything.
 
 @node Source_Location
 @section Source_Location
diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb
index 06b2d38c766..32fa2a13c5b 100644
--- a/gcc/ada/prj.adb
+++ b/gcc/ada/prj.adb
@@ -34,6 +34,7 @@ with Snames;   use Snames;
 with Uintp;    use Uintp;
 
 with Ada.Characters.Handling;    use Ada.Characters.Handling;
+with Ada.Containers.Ordered_Sets;
 with Ada.Unchecked_Deallocation;
 
 with GNAT.Case_Util;            use GNAT.Case_Util;
@@ -523,101 +524,128 @@ package body Prj is
       Include_Aggregated : Boolean := True;
       Imported_First     : Boolean := False)
    is
-
       use Project_Boolean_Htable;
-      Seen : Project_Boolean_Htable.Instance := Project_Boolean_Htable.Nil;
 
-      procedure Recursive_Check
+      procedure Recursive_Check_Context
         (Project          : Project_Id;
          Tree             : Project_Tree_Ref;
          In_Aggregate_Lib : Boolean);
-      --  Check if a project has already been seen. If not seen, mark it
-      --  as Seen, Call Action, and check all its imported and aggregated
-      --  projects.
+      --  Recursively handle the project tree creating a new context for
+      --  keeping track about already handled projects.
 
-      ---------------------
-      -- Recursive_Check --
-      ---------------------
+      -----------------------------
+      -- Recursive_Check_Context --
+      -----------------------------
 
-      procedure Recursive_Check
+      procedure Recursive_Check_Context
         (Project          : Project_Id;
          Tree             : Project_Tree_Ref;
          In_Aggregate_Lib : Boolean)
       is
-         List : Project_List;
-         T    : Project_Tree_Ref;
+         package Name_Id_Set is
+           new Ada.Containers.Ordered_Sets (Element_Type => Name_Id);
 
-      begin
-         if not Get (Seen, Project) then
+         Seen_Name : Name_Id_Set.Set;
+         --  This set is needed to ensure that we do not haandle the same
+         --  project twice in the context of aggregate libraries.
 
-            --  Even if a project is aggregated multiple times, we will only
-            --  return it once.
+         procedure Recursive_Check
+           (Project          : Project_Id;
+            Tree             : Project_Tree_Ref;
+            In_Aggregate_Lib : Boolean);
+         --  Check if project has already been seen. If not, mark it as Seen,
+         --  Call Action, and check all its imported and aggregated projects.
 
-            Set (Seen, Project, True);
+         ---------------------
+         -- Recursive_Check --
+         ---------------------
 
-            if not Imported_First then
-               Action (Project, Tree, In_Aggregate_Lib, With_State);
-            end if;
+         procedure Recursive_Check
+           (Project          : Project_Id;
+            Tree             : Project_Tree_Ref;
+            In_Aggregate_Lib : Boolean)
+         is
+            List : Project_List;
+            T    : Project_Tree_Ref;
+
+         begin
+            if not Seen_Name.Contains (Project.Name) then
 
-            --  Visit all extended projects
+               --  Even if a project is aggregated multiple times in an
+               --  aggregated library, we will only return it once.
 
-            if Project.Extends /= No_Project then
-               Recursive_Check (Project.Extends, Tree, In_Aggregate_Lib);
-            end if;
+               Seen_Name.Include (Project.Name);
 
-            --  Visit all imported projects if needed. This is not needed
-            --  for an aggregate library as imported libraries are just
-            --  there for dependency support.
+               if not Imported_First then
+                  Action (Project, Tree, In_Aggregate_Lib, With_State);
+               end if;
+
+               --  Visit all extended projects
+
+               if Project.Extends /= No_Project then
+                  Recursive_Check (Project.Extends, Tree, In_Aggregate_Lib);
+               end if;
+
+               --  Visit all imported projects
 
-            if Project.Qualifier /= Aggregate_Library
-              or else not Include_Aggregated
-            then
                List := Project.Imported_Projects;
                while List /= null loop
                   Recursive_Check (List.Project, Tree, In_Aggregate_Lib);
                   List := List.Next;
                end loop;
-            end if;
 
-            --  Visit all aggregated projects
+               --  Visit all aggregated projects
 
-            if Include_Aggregated
-              and then Project.Qualifier in Aggregate_Project
-            then
-               declare
-                  Agg : Aggregated_Project_List;
-               begin
-                  Agg := Project.Aggregated_Projects;
-                  while Agg /= null loop
-                     pragma Assert (Agg.Project /= No_Project);
-
-                     --  For aggregated libraries, the tree must be the one
-                     --  of the aggregate library.
-
-                     if Project.Qualifier = Aggregate_Library then
-                        T := Tree;
-                     else
-                        T := Agg.Tree;
-                     end if;
-
-                     Recursive_Check
-                       (Agg.Project, T, Project.Qualifier = Aggregate_Library);
-                     Agg := Agg.Next;
-                  end loop;
-               end;
-            end if;
+               if Include_Aggregated
+                 and then Project.Qualifier in Aggregate_Project
+               then
+                  declare
+                     Agg : Aggregated_Project_List;
+
+                  begin
+                     Agg := Project.Aggregated_Projects;
+                     while Agg /= null loop
+                        pragma Assert (Agg.Project /= No_Project);
+
+                        --  For aggregated libraries, the tree must be the one
+                        --  of the aggregate library.
+
+                        if Project.Qualifier = Aggregate_Library then
+                           T := Tree;
+                           Recursive_Check (Agg.Project, T, True);
+
+                        else
+                           T := Agg.Tree;
+
+                           --  Use a new context as we want to returns the same
+                           --  project in different project tree for aggregated
+                           --  projects.
 
-            if Imported_First then
-               Action (Project, Tree, In_Aggregate_Lib, With_State);
+                           Recursive_Check_Context (Agg.Project, T, False);
+                        end if;
+
+                        Agg := Agg.Next;
+                     end loop;
+                  end;
+               end if;
+
+               if Imported_First then
+                  Action (Project, Tree, In_Aggregate_Lib, With_State);
+               end if;
             end if;
-         end if;
-      end Recursive_Check;
+         end Recursive_Check;
+
+      --  Start of processing for Recursive_Check_Context
+
+      begin
+         Recursive_Check (Project, Tree, In_Aggregate_Lib);
+      end Recursive_Check_Context;
 
    --  Start of processing for For_Every_Project_Imported
 
    begin
-      Recursive_Check (Project => By, Tree => Tree, In_Aggregate_Lib => False);
-      Reset (Seen);
+      Recursive_Check_Context
+        (Project => By, Tree => Tree, In_Aggregate_Lib => False);
    end For_Every_Project_Imported;
 
    -----------------
diff --git a/gcc/ada/sem_intr.adb b/gcc/ada/sem_intr.adb
index 26f9ff4a74b..f650be9c579 100644
--- a/gcc/ada/sem_intr.adb
+++ b/gcc/ada/sem_intr.adb
@@ -455,12 +455,14 @@ package body Sem_Intr is
          return;
       end if;
 
-      Size := UI_To_Int (Esize (Typ1));
+      --  type'Size (not 'Object_Size!) must be one of the allowed values
 
-      if Size /= 8
-        and then Size /= 16
-        and then Size /= 32
-        and then Size /= 64
+      Size := UI_To_Int (RM_Size (Typ1));
+
+      if Size /= 8  and then
+         Size /= 16 and then
+         Size /= 32 and then
+         Size /= 64
       then
          Errint
            ("first argument for shift must have size 8, 16, 32 or 64",
@@ -469,8 +471,7 @@ package body Sem_Intr is
 
       elsif Non_Binary_Modulus (Typ1) then
          Errint
-           ("shifts not allowed for non-binary modular types",
-            Ptyp1, N);
+           ("shifts not allowed for non-binary modular types", Ptyp1, N);
 
       elsif Etype (Arg1) /= Etype (E) then
          Errint