+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
* Exception_Name::
* File::
* Line::
-* Rotate_Left::
-* Rotate_Right::
-* Shift_Left::
-* Shift_Right::
-* Shift_Right_Arithmetic::
+* Shifts and Rotates::
* Source_Location::
@end menu
@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
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;
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;
-----------------
OSDN Git Service
